Subversion Repositories spacemission

Rev

Rev 1 | Go to most recent revision | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 1 Rev 4
Line -... Line 1...
-
 
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
 ******************************************************************************)
1
 unit DXDraws;
93
unit DXDraws;
2
 
94
 
3
interface
95
interface
4
 
96
 
5
{$INCLUDE DelphiXcfg.inc}
97
{$INCLUDE DelphiXcfg.inc}
6
 
98
 
7
uses
99
uses
8
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
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}
9
  DXClass, DIB, DXTexImg, DirectX;
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);
10
 
139
 
11
type
140
type
12
 
141
 
-
 
142
  {  TRenderType  }
-
 
143
 
-
 
144
  TRenderType = (rtDraw, rtBlend, rtAdd, rtSub);
-
 
145
 
-
 
146
  {  TRenderMirrorFlip  }
-
 
147
 
-
 
148
  TRenderMirrorFlip = (rmfMirror, rmfFlip);
-
 
149
  TRenderMirrorFlipSet = set of TRenderMirrorFlip;
-
 
150
 
13
  {  EDirectDrawError  }
151
  {  EDirectDrawError  }
14
 
152
 
15
  EDirectDrawError = class(EDirectXError);
153
  EDirectDrawError = class(EDirectXError);
16
  EDirectDrawPaletteError = class(EDirectDrawError);
154
  EDirectDrawPaletteError = class(EDirectDrawError);
17
  EDirectDrawClipperError = class(EDirectDrawError);
155
  EDirectDrawClipperError = class(EDirectDrawError);
Line 23... Line 161...
23
  TDirectDrawPalette = class;
161
  TDirectDrawPalette = class;
24
  TDirectDrawSurface = class;
162
  TDirectDrawSurface = class;
25
 
163
 
26
  TDirectDraw = class(TDirectX)
164
  TDirectDraw = class(TDirectX)
27
  private
165
  private
-
 
166
    {$IFDEF D3D_deprecated}
28
    FIDDraw: IDirectDraw;
167
    FIDDraw: IDirectDraw;
29
    FIDDraw4: IDirectDraw4;
168
    FIDDraw4: IDirectDraw4;
-
 
169
    {$ENDIF}
30
    FIDDraw7: IDirectDraw7;
170
    FIDDraw7: IDirectDraw7;
31
    FDriverCaps: TDDCaps;
171
    FDriverCaps: TDDCaps;
32
    FHELCaps: TDDCaps;
172
    FHELCaps: TDDCaps;
33
    FClippers: TList;
173
    FClippers: TList;
34
    FPalettes: TList;
174
    FPalettes: TList;
35
    FSurfaces: TList;
175
    FSurfaces: TList;
36
    function GetClipper(Index: Integer): TDirectDrawClipper;
176
    function GetClipper(Index: Integer): TDirectDrawClipper;
37
    function GetClipperCount: Integer;
177
    function GetClipperCount: Integer;
38
    function GetDisplayMode: TDDSurfaceDesc;
178
    function GetDisplayMode: {$IFDEF D3D_deprecated}TDDSurfaceDesc{$ELSE}TDDSurfaceDesc2{$ENDIF};
-
 
179
    {$IFDEF D3D_deprecated}
39
    function GetIDDraw: IDirectDraw;
180
    function GetIDDraw: IDirectDraw;
40
    function GetIDDraw4: IDirectDraw4;
181
    function GetIDDraw4: IDirectDraw4;
-
 
182
    {$ENDIF}
41
    function GetIDDraw7: IDirectDraw7;
183
    function GetIDDraw7: IDirectDraw7;
-
 
184
    {$IFDEF D3D_deprecated}
42
    function GetIDraw: IDirectDraw;
185
    function GetIDraw: IDirectDraw;
43
    function GetIDraw4: IDirectDraw4;
186
    function GetIDraw4: IDirectDraw4;
-
 
187
    {$ENDIF}
44
    function GetIDraw7: IDirectDraw7;
188
    function GetIDraw7: IDirectDraw7;
45
    function GetPalette(Index: Integer): TDirectDrawPalette;
189
    function GetPalette(Index: Integer): TDirectDrawPalette;
46
    function GetPaletteCount: Integer;
190
    function GetPaletteCount: Integer;
47
    function GetSurface(Index: Integer): TDirectDrawSurface;
191
    function GetSurface(Index: Integer): TDirectDrawSurface;
48
    function GetSurfaceCount: Integer;
192
    function GetSurfaceCount: Integer;
49
  public
193
  public
50
    constructor Create(GUID: PGUID);
194
    constructor Create(GUID: PGUID);
51
    constructor CreateEx(GUID: PGUID; DirectX7Mode: Boolean);
195
    constructor CreateEx(GUID: PGUID; DirectX7Mode: Boolean);
52
    destructor Destroy; override;
196
    destructor Destroy; override;
53
    class function Drivers: TDirectXDrivers;
197
    class function Drivers: TDirectXDrivers;
-
 
198
    {$IFDEF _DMO_}class function DriversEx: TDirectXDriversEx;{$ENDIF}
54
    property ClipperCount: Integer read GetClipperCount;
199
    property ClipperCount: Integer read GetClipperCount;
55
    property Clippers[Index: Integer]: TDirectDrawClipper read GetClipper;
200
    property Clippers[Index: Integer]: TDirectDrawClipper read GetClipper;
56
    property DisplayMode: TDDSurfaceDesc read GetDisplayMode;
201
    property DisplayMode: {$IFDEF D3D_deprecated}TDDSurfaceDesc{$ELSE}TDDSurfaceDesc2{$ENDIF} read GetDisplayMode;
57
    property DriverCaps: TDDCaps read FDriverCaps;
202
    property DriverCaps: TDDCaps read FDriverCaps;
58
    property HELCaps: TDDCaps read FHELCaps;
203
    property HELCaps: TDDCaps read FHELCaps;
-
 
204
    {$IFDEF D3D_deprecated}
59
    property IDDraw: IDirectDraw read GetIDDraw;
205
    property IDDraw: IDirectDraw read GetIDDraw;
60
    property IDDraw4: IDirectDraw4 read GetIDDraw4;
206
    property IDDraw4: IDirectDraw4 read GetIDDraw4;
-
 
207
    {$ENDIF}
61
    property IDDraw7: IDirectDraw7 read GetIDDraw7;
208
    property IDDraw7: IDirectDraw7 read GetIDDraw7;
-
 
209
    {$IFDEF D3D_deprecated}
62
    property IDraw: IDirectDraw read GetIDraw;
210
    property IDraw: IDirectDraw read GetIDraw;
63
    property IDraw4: IDirectDraw4 read GetIDraw4;
211
    property IDraw4: IDirectDraw4 read GetIDraw4;
-
 
212
    {$ENDIF}
64
    property IDraw7: IDirectDraw7 read GetIDraw7;
213
    property IDraw7: IDirectDraw7 read GetIDraw7;
65
    property PaletteCount: Integer read GetPaletteCount;
214
    property PaletteCount: Integer read GetPaletteCount;
66
    property Palettes[Index: Integer]: TDirectDrawPalette read GetPalette;
215
    property Palettes[Index: Integer]: TDirectDrawPalette read GetPalette;
67
    property SurfaceCount: Integer read GetSurfaceCount;
216
    property SurfaceCount: Integer read GetSurfaceCount;
68
    property Surfaces[Index: Integer]: TDirectDrawSurface read GetSurface;
217
    property Surfaces[Index: Integer]: TDirectDrawSurface read GetSurface;
Line 125... Line 274...
125
  public
274
  public
126
    constructor Create(ASurface: TDirectDrawSurface);
275
    constructor Create(ASurface: TDirectDrawSurface);
127
    destructor Destroy; override;
276
    destructor Destroy; override;
128
    procedure Release;
277
    procedure Release;
129
  end;
278
  end;
130
   
279
 
131
  {  TDirectDrawSurface  }
280
  {  TDirectDrawSurface  }
132
 
281
 
133
  TDirectDrawSurface = class(TDirectX)
282
  TDirectDrawSurface = class(TDirectX)
134
  private
283
  private
135
    FCanvas: TDirectDrawSurfaceCanvas;
284
    FCanvas: TDirectDrawSurfaceCanvas;
136
    FHasClipper: Boolean;
285
    FHasClipper: Boolean;
137
    FDDraw: TDirectDraw;
286
    FDDraw: TDirectDraw;
-
 
287
    {$IFDEF D3D_deprecated}
138
    FIDDSurface: IDirectDrawSurface;
288
    FIDDSurface: IDirectDrawSurface;
139
    FIDDSurface4: IDirectDrawSurface4;
289
    FIDDSurface4: IDirectDrawSurface4;
-
 
290
    {$ENDIF}
140
    FIDDSurface7: IDirectDrawSurface7;
291
    FIDDSurface7: IDirectDrawSurface7;
141
    FSystemMemory: Boolean;
292
    FSystemMemory: Boolean;
142
    FStretchDrawClipper: IDirectDrawClipper;
293
    FStretchDrawClipper: IDirectDrawClipper;
143
    FSurfaceDesc: TDDSurfaceDesc;
294
    FSurfaceDesc: {$IFDEF D3D_deprecated}TDDSurfaceDesc{$ELSE}TDDSurfaceDesc2{$ENDIF};
144
    FGammaControl: IDirectDrawGammaControl;
295
    FGammaControl: IDirectDrawGammaControl;
145
    FLockSurfaceDesc: TDDSurfaceDesc;
296
    FLockSurfaceDesc: {$IFDEF D3D_deprecated}TDDSurfaceDesc{$ELSE}TDDSurfaceDesc2{$ENDIF};
146
    FLockCount: Integer;
297
    FLockCount: Integer;
-
 
298
    FIsLocked: Boolean;
-
 
299
    FModified: Boolean;
-
 
300
    FCaption: TCaption;
-
 
301
    DIB_COLMATCH: TDIB;
147
    function GetBitCount: Integer;
302
    function GetBitCount: Integer;
148
    function GetCanvas: TDirectDrawSurfaceCanvas;
303
    function GetCanvas: TDirectDrawSurfaceCanvas;
149
    function GetClientRect: TRect;
304
    function GetClientRect: TRect;
150
    function GetHeight: Integer;
305
    function GetHeight: Integer;
-
 
306
    {$IFDEF D3D_deprecated}
151
    function GetIDDSurface: IDirectDrawSurface;
307
    function GetIDDSurface: IDirectDrawSurface; {$IFDEF VER9UP}inline;{$ENDIF}
152
    function GetIDDSurface4: IDirectDrawSurface4;
308
    function GetIDDSurface4: IDirectDrawSurface4; {$IFDEF VER9UP}inline;{$ENDIF}
-
 
309
    {$ENDIF}
153
    function GetIDDSurface7: IDirectDrawSurface7;
310
    function GetIDDSurface7: IDirectDrawSurface7; {$IFDEF VER9UP}inline;{$ENDIF}
-
 
311
    {$IFDEF D3D_deprecated}
154
    function GetISurface: IDirectDrawSurface;
312
    function GetISurface: IDirectDrawSurface;
155
    function GetISurface4: IDirectDrawSurface4;
313
    function GetISurface4: IDirectDrawSurface4;
-
 
314
    {$ENDIF}
156
    function GetISurface7: IDirectDrawSurface7;
315
    function GetISurface7: IDirectDrawSurface7;
157
    function GetPixel(X, Y: Integer): Longint;
316
    function GetPixel(X, Y: Integer): Longint;
158
    function GetWidth: Integer;
317
    function GetWidth: Integer;
159
    procedure SetClipper(Value: TDirectDrawClipper);
318
    procedure SetClipper(Value: TDirectDrawClipper);
160
    procedure SetColorKey(Flags: DWORD; const Value: TDDColorKey);
319
    procedure SetColorKey(Flags: DWORD; const Value: TDDColorKey);
-
 
320
    {$IFDEF D3D_deprecated}
161
    procedure SetIDDSurface(Value: IDirectDrawSurface);
321
    procedure SetIDDSurface(Value: IDirectDrawSurface);
162
    procedure SetIDDSurface4(Value: IDirectDrawSurface4);
322
    procedure SetIDDSurface4(Value: IDirectDrawSurface4);
-
 
323
    {$ENDIF}
163
    procedure SetIDDSurface7(Value: IDirectDrawSurface7);
324
    procedure SetIDDSurface7(Value: IDirectDrawSurface7);
164
    procedure SetPalette(Value: TDirectDrawPalette);
325
    procedure SetPalette(Value: TDirectDrawPalette);
165
    procedure SetPixel(X, Y: Integer; Value: Longint);
326
    procedure SetPixel(X, Y: Integer; Value: Longint);
166
    procedure SetTransparentColor(Col: 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}
167
  public
344
  public
168
    constructor Create(ADirectDraw: TDirectDraw);
345
    constructor Create(ADirectDraw: TDirectDraw);
169
    destructor Destroy; override;
346
    destructor Destroy; override;
170
    procedure Assign(Source: TPersistent); override;
347
    procedure Assign(Source: TPersistent); override;
171
    procedure AssignTo(Dest: TPersistent); override;
348
    procedure AssignTo(Dest: TPersistent); override;
172
    function Blt(const DestRect, SrcRect: TRect; Flags: DWORD;
349
    function Blt(const DestRect, SrcRect: TRect; Flags: DWORD;
173
      const DF: TDDBltFX; Source: TDirectDrawSurface): Boolean;
350
      const DF: TDDBltFX; Source: TDirectDrawSurface): Boolean; {$IFDEF VER9UP}inline;{$ENDIF}
174
    function BltFast(X, Y: Integer; const SrcRect: TRect;
351
    function BltFast(X, Y: Integer; const SrcRect: TRect;
175
      Flags: DWORD; Source: TDirectDrawSurface): Boolean;
352
      Flags: DWORD; Source: TDirectDrawSurface): Boolean; {$IFDEF VER9UP}inline;{$ENDIF}
176
    function ColorMatch(Col: TColor): Integer;
353
    function ColorMatch(Col: TColor): Integer; {$IFDEF VER9UP}inline;{$ENDIF}
-
 
354
  {$IFDEF VER4UP}
177
{$IFDEF DelphiX_Spt4}
355
    {$IFDEF D3D_deprecated}
178
    function CreateSurface(const SurfaceDesc: TDDSurfaceDesc): Boolean; overload;
356
    function CreateSurface(SurfaceDesc: TDDSurfaceDesc): Boolean; overload;
-
 
357
    {$ENDIF}
179
    function CreateSurface(const SurfaceDesc: TDDSurfaceDesc2): Boolean; overload;
358
    function CreateSurface(SurfaceDesc: TDDSurfaceDesc2): Boolean; overload;
180
{$ELSE}
359
  {$ELSE}
181
    function CreateSurface(const SurfaceDesc: TDDSurfaceDesc): Boolean;
360
    function CreateSurface(SurfaceDesc: TDDSurfaceDesc): Boolean;
182
{$ENDIF}
361
  {$ENDIF}
-
 
362
 
-
 
363
    procedure MirrorFlip(Value: TRenderMirrorFlipSet);
-
 
364
 
183
{$IFDEF DelphiX_Spt4}
365
  {$IFDEF VER4UP}
184
    procedure Draw(X, Y: Integer; SrcRect: TRect; Source: TDirectDrawSurface; Transparent: Boolean=True); overload;
366
    procedure Draw(X, Y: Integer; SrcRect: TRect; Source: TDirectDrawSurface; Transparent: Boolean = True); overload;
185
    procedure Draw(X, Y: Integer; Source: TDirectDrawSurface; Transparent: Boolean=True); overload;
367
    procedure Draw(X, Y: Integer; Source: TDirectDrawSurface; Transparent: Boolean = True); overload;
186
    procedure StretchDraw(const DestRect, SrcRect: TRect; Source: TDirectDrawSurface;
368
    procedure StretchDraw(const DestRect, SrcRect: TRect; Source: TDirectDrawSurface;
187
      Transparent: Boolean=True); overload;
369
      Transparent: Boolean = True); overload;
188
    procedure StretchDraw(const DestRect: TRect; Source: TDirectDrawSurface;
370
    procedure StretchDraw(const DestRect: TRect; Source: TDirectDrawSurface;
189
      Transparent: Boolean=True); overload;
371
      Transparent: Boolean = True); overload;
190
{$ELSE}
372
  {$ELSE}
191
    procedure Draw(X, Y: Integer; SrcRect: TRect; Source: TDirectDrawSurface;
373
    procedure Draw(X, Y: Integer; SrcRect: TRect; Source: TDirectDrawSurface;
192
      Transparent: Boolean);
374
      Transparent: Boolean);
193
    procedure StretchDraw(const DestRect, SrcRect: TRect; Source: TDirectDrawSurface;
375
    procedure StretchDraw(const DestRect, SrcRect: TRect; Source: TDirectDrawSurface;
194
      Transparent: Boolean);
376
      Transparent: Boolean);
195
{$ENDIF}
377
  {$ENDIF}
196
    procedure DrawAdd(const DestRect, SrcRect: TRect; Source: TDirectDrawSurface;
378
    procedure DrawAdd(const DestRect, SrcRect: TRect; Source: TDirectDrawSurface;
197
      Transparent: Boolean; Alpha: Integer{$IFDEF DelphiX_Spt4}=255{$ENDIF});
379
      Transparent: Boolean; Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF});
198
    procedure DrawAlpha(const DestRect, SrcRect: TRect; Source: TDirectDrawSurface;
380
    procedure DrawAlpha(const DestRect, SrcRect: TRect; Source: TDirectDrawSurface;
199
      Transparent: Boolean; Alpha: Integer);
381
      Transparent: Boolean; Alpha: Integer);
200
    procedure DrawSub(const DestRect, SrcRect: TRect; Source: TDirectDrawSurface;
382
    procedure DrawSub(const DestRect, SrcRect: TRect; Source: TDirectDrawSurface;
201
      Transparent: Boolean; Alpha: Integer{$IFDEF DelphiX_Spt4}=255{$ENDIF});
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}
202
    procedure DrawRotate(X, Y, Width, Height: Integer; const SrcRect: TRect;
393
    procedure DrawRotate(X, Y, Width, Height: Integer; const SrcRect: TRect;
203
      Source: TDirectDrawSurface; CenterX, CenterY: Double; Transparent: Boolean; Angle: Integer);
394
      Source: TDirectDrawSurface; CenterX, CenterY: Double; Transparent: Boolean; Angle: single);
204
    procedure DrawRotateAdd(X, Y, Width, Height: Integer; const SrcRect: TRect;
395
    procedure DrawRotateAdd(X, Y, Width, Height: Integer; const SrcRect: TRect;
205
      Source: TDirectDrawSurface; CenterX, CenterY: Double; Transparent: Boolean; Angle: Integer;
396
      Source: TDirectDrawSurface; CenterX, CenterY: Double; Transparent: Boolean; Angle: single;
206
      Alpha: Integer{$IFDEF DelphiX_Spt4}=255{$ENDIF});
397
      Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF});
207
    procedure DrawRotateAlpha(X, Y, Width, Height: Integer; const SrcRect: TRect;
398
    procedure DrawRotateAlpha(X, Y, Width, Height: Integer; const SrcRect: TRect;
208
      Source: TDirectDrawSurface; CenterX, CenterY: Double; Transparent: Boolean; Angle: Integer;
399
      Source: TDirectDrawSurface; CenterX, CenterY: Double; Transparent: Boolean; Angle: single;
209
      Alpha: Integer);
400
      Alpha: Integer);
210
    procedure DrawRotateSub(X, Y, Width, Height: Integer; const SrcRect: TRect;
401
    procedure DrawRotateSub(X, Y, Width, Height: Integer; const SrcRect: TRect;
211
      Source: TDirectDrawSurface; CenterX, CenterY: Double; Transparent: Boolean; Angle: Integer;
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;
212
      Alpha: Integer{$IFDEF DelphiX_Spt4}=255{$ENDIF});
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}
213
    procedure DrawWaveX(X, Y, Width, Height: Integer; const SrcRect: TRect;
421
    procedure DrawWaveX(X, Y, Width, Height: Integer; const SrcRect: TRect;
214
      Source: TDirectDrawSurface; Transparent: Boolean; amp, Len, ph: Integer);
422
      Source: TDirectDrawSurface; Transparent: Boolean; amp, Len, ph: Integer);
215
    procedure DrawWaveXAdd(X, Y, Width, Height: Integer; const SrcRect: TRect;
423
    procedure DrawWaveXAdd(X, Y, Width, Height: Integer; const SrcRect: TRect;
216
      Source: TDirectDrawSurface; Transparent: Boolean; amp, Len, ph: Integer;
424
      Source: TDirectDrawSurface; Transparent: Boolean; amp, Len, ph: Integer;
217
      Alpha: Integer{$IFDEF DelphiX_Spt4}=255{$ENDIF});
425
      Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF});
218
    procedure DrawWaveXAlpha(X, Y, Width, Height: Integer; const SrcRect: TRect;
426
    procedure DrawWaveXAlpha(X, Y, Width, Height: Integer; const SrcRect: TRect;
219
      Source: TDirectDrawSurface; Transparent: Boolean; amp, Len, ph: Integer;
427
      Source: TDirectDrawSurface; Transparent: Boolean; amp, Len, ph: Integer;
220
      Alpha: Integer);
428
      Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF});
221
    procedure DrawWaveXSub(X, Y, Width, Height: Integer; const SrcRect: TRect;
429
    procedure DrawWaveXSub(X, Y, Width, Height: Integer; const SrcRect: TRect;
222
      Source: TDirectDrawSurface; Transparent: Boolean; amp, Len, ph: Integer;
430
      Source: TDirectDrawSurface; Transparent: Boolean; amp, Len, ph: Integer;
223
      Alpha: Integer{$IFDEF DelphiX_Spt4}=255{$ENDIF});
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}
224
    procedure Fill(DevColor: Longint);
461
    procedure Fill(DevColor: Longint);
225
    procedure FillRect(const Rect: TRect; DevColor: Longint);
462
    procedure FillRect(const Rect: TRect; DevColor: Longint);
226
    procedure FillRectAdd(const DestRect: TRect; Color: TColor);
463
    procedure FillRectAdd(const DestRect: TRect; Color: TColor; Alpha: Byte{$IFDEF VER4UP} = 128{$ENDIF});
227
    procedure FillRectAlpha(const DestRect: TRect; Color: TColor; Alpha: Integer);
464
    procedure FillRectAlpha(const DestRect: TRect; Color: TColor; Alpha: Integer);
228
    procedure FillRectSub(const DestRect: TRect; Color: TColor);
465
    procedure FillRectSub(const DestRect: TRect; Color: TColor; Alpha: Byte{$IFDEF VER4UP} = 128{$ENDIF});
-
 
466
    {Load}
229
    procedure LoadFromDIB(DIB: TDIB);
467
    procedure LoadFromDIB(DIB: TDIB);
230
    procedure LoadFromDIBRect(DIB: TDIB; AWidth, AHeight: Integer; const SrcRect: TRect);
468
    procedure LoadFromDIBRect(DIB: TDIB; AWidth, AHeight: Integer; const SrcRect: TRect);
231
    procedure LoadFromGraphic(Graphic: TGraphic);
469
    procedure LoadFromGraphic(Graphic: TGraphic);
232
    procedure LoadFromGraphicRect(Graphic: TGraphic; AWidth, AHeight: Integer; const SrcRect: TRect);
470
    procedure LoadFromGraphicRect(Graphic: TGraphic; AWidth, AHeight: Integer; const SrcRect: TRect);
233
    procedure LoadFromFile(const FileName: string);
471
    procedure LoadFromFile(const FileName: string);
234
    procedure LoadFromStream(Stream: TStream);
472
    procedure LoadFromStream(Stream: TStream);
235
{$IFDEF DelphiX_Spt4}
473
    {$IFDEF VER4UP}
236
    function Lock(const Rect: TRect; var SurfaceDesc: TDDSurfaceDesc): Boolean; overload;
474
    function Lock(const Rect: TRect; var SurfaceDesc: {$IFDEF D3D_deprecated}TDDSurfaceDesc{$ELSE}TDDSurfaceDesc2{$ENDIF}): Boolean; overload;
237
    function Lock(var SurfaceDesc: TDDSurfaceDesc): Boolean; overload;
475
    function Lock(var SurfaceDesc: {$IFDEF D3D_deprecated}TDDSurfaceDesc{$ELSE}TDDSurfaceDesc2{$ENDIF}): Boolean; overload;
-
 
476
    function Lock: Boolean; overload;
238
{$ELSE}
477
    {$ELSE}
-
 
478
    function LockSurface: Boolean;
239
    function Lock(const Rect: TRect; var SurfaceDesc: TDDSurfaceDesc): Boolean;
479
    function Lock(const Rect: TRect; var SurfaceDesc: TDDSurfaceDesc): Boolean;
240
{$ENDIF}
480
    {$ENDIF}
241
    procedure UnLock;
481
    procedure UnLock;
242
    function Restore: Boolean;
482
    function Restore: Boolean;
-
 
483
    property IsLocked: Boolean read FIsLocked;
243
    procedure SetSize(AWidth, AHeight: Integer);
484
    procedure SetSize(AWidth, AHeight: Integer);
-
 
485
    property Modified: Boolean read FModified write FModified;
244
    property BitCount: Integer read GetBitCount;
486
    property BitCount: Integer read GetBitCount;
245
    property Canvas: TDirectDrawSurfaceCanvas read GetCanvas;
487
    property Canvas: TDirectDrawSurfaceCanvas read GetCanvas;
246
    property ClientRect: TRect read GetClientRect;
488
    property ClientRect: TRect read GetClientRect;
247
    property Clipper: TDirectDrawClipper write SetClipper;
489
    property Clipper: TDirectDrawClipper write SetClipper;
248
    property ColorKey[Flags: DWORD]: TDDColorKey write SetColorKey;
490
    property ColorKey[Flags: DWORD]: TDDColorKey write SetColorKey;
249
    property DDraw: TDirectDraw read FDDraw;
491
    property DDraw: TDirectDraw read FDDraw;
250
    property GammaControl: IDirectDrawGammaControl read FGammaControl;
492
    property GammaControl: IDirectDrawGammaControl read FGammaControl;
251
    property Height: Integer read GetHeight;
493
    property Height: Integer read GetHeight;
-
 
494
    {$IFDEF D3D_deprecated}
252
    property IDDSurface: IDirectDrawSurface read GetIDDSurface write SetIDDSurface;
495
    property IDDSurface: IDirectDrawSurface read GetIDDSurface write SetIDDSurface;
253
    property IDDSurface4: IDirectDrawSurface4 read GetIDDSurface4 write SetIDDSurface4;
496
    property IDDSurface4: IDirectDrawSurface4 read GetIDDSurface4 write SetIDDSurface4;
-
 
497
    {$ENDIF}
254
    property IDDSurface7: IDirectDrawSurface7 read GetIDDSurface7 write SetIDDSurface7;
498
    property IDDSurface7: IDirectDrawSurface7 read GetIDDSurface7 write SetIDDSurface7;
-
 
499
    {$IFDEF D3D_deprecated}
255
    property ISurface: IDirectDrawSurface read GetISurface;
500
    property ISurface: IDirectDrawSurface read GetISurface;
256
    property ISurface4: IDirectDrawSurface4 read GetISurface4;
501
    property ISurface4: IDirectDrawSurface4 read GetISurface4;
-
 
502
    {$ENDIF}
257
    property ISurface7: IDirectDrawSurface7 read GetISurface7;
503
    property ISurface7: IDirectDrawSurface7 read GetISurface7;
258
    property Palette: TDirectDrawPalette write SetPalette;
504
    property Palette: TDirectDrawPalette write SetPalette;
259
    property Pixels[X, Y: Integer]: Longint read GetPixel write SetPixel;
505
    property Pixels[X, Y: Integer]: Longint read GetPixel write SetPixel;
-
 
506
    property Pixel[X, Y: Integer]: LongInt read Peek write Poke;
260
    property SurfaceDesc: TDDSurfaceDesc read FSurfaceDesc;
507
    property SurfaceDesc: {$IFDEF D3D_deprecated}TDDSurfaceDesc{$ELSE}TDDSurfaceDesc2{$ENDIF} read FSurfaceDesc;
261
    property SystemMemory: Boolean read FSystemMemory write FSystemMemory;
508
    property SystemMemory: Boolean read FSystemMemory write FSystemMemory;
262
    property TransparentColor: Longint write SetTransparentColor;
509
    property TransparentColor: Longint write SetTransparentColor;
263
    property Width: Integer read GetWidth;
510
    property Width: Integer read GetWidth;
-
 
511
    property Caption: TCaption read FCaption write FCaption;
264
  end;
512
  end;
265
 
513
 
266
  {  TDXDrawDisplay  }
514
  {  TDXDrawDisplay  }
267
 
515
 
268
  TCustomDXDraw = class;
516
  TCustomDXDraw = class;
Line 295... Line 543...
295
    function GetMode2(Index: Integer): TDXDrawDisplayMode;
543
    function GetMode2(Index: Integer): TDXDrawDisplayMode;
296
    procedure LoadDisplayModes;
544
    procedure LoadDisplayModes;
297
    procedure SetBitCount(Value: Integer);
545
    procedure SetBitCount(Value: Integer);
298
    procedure SetHeight(Value: Integer);
546
    procedure SetHeight(Value: Integer);
299
    procedure SetWidth(Value: Integer);
547
    procedure SetWidth(Value: Integer);
300
    function SetSize(AWidth, AHeight, ABitCount: Integer): Boolean;
548
    function SetSize(AWidth, AHeight, ABitCount{$IFNDEF D3D_deprecated}, ARefreshRate, AFlags{$ENDIF}: Integer): Boolean;
301
    function DynSetSize(AWidth, AHeight, ABitCount: Integer): Boolean;
549
    function DynSetSize(AWidth, AHeight, ABitCount: Integer): Boolean;
302
  public
550
  public
303
    constructor Create(ADXDraw: TCustomDXDraw);
551
    constructor Create(ADXDraw: TCustomDXDraw);
304
    destructor Destroy; override;
552
    destructor Destroy; override;
305
    procedure Assign(Source: TPersistent); override;
553
    procedure Assign(Source: TPersistent); override;
306
    function IndexOf(Width, Height, BitCount: Integer): Integer;
554
    function IndexOf(Width, Height, BitCount: Integer): Integer;
307
    property Count: Integer read GetCount;
555
    property Count: Integer read GetCount;
308
    property Mode: TDXDrawDisplayMode read GetMode;
556
    property Mode: TDXDrawDisplayMode read GetMode;
309
    property Modes[Index: Integer]: TDXDrawDisplayMode read GetMode2; default;
557
    property Modes[Index: Integer]: TDXDrawDisplayMode read GetMode2; default;
310
  published
558
  published
311
    property BitCount: Integer read FBitCount write SetBitCount default 8;
559
    property BitCount: Integer read FBitCount write SetBitCount default 16;
312
    property FixedBitCount: Boolean read FFixedBitCount write FFixedBitCount;
560
    property FixedBitCount: Boolean read FFixedBitCount write FFixedBitCount;
313
    property FixedRatio: Boolean read FFixedRatio write FFixedRatio;
561
    property FixedRatio: Boolean read FFixedRatio write FFixedRatio;
314
    property FixedSize: Boolean read FFixedSize write FFixedSize;
562
    property FixedSize: Boolean read FFixedSize write FFixedSize;
315
    property Height: Integer read FHeight write SetHeight default 480;
563
    property Height: Integer read FHeight write SetHeight default 480;
316
    property Width: Integer read FWidth write SetWidth default 640;
564
    property Width: Integer read FWidth write SetWidth default 640;
Line 321... Line 569...
321
 
569
 
322
  {  EDXDrawError  }
570
  {  EDXDrawError  }
323
 
571
 
324
  EDXDrawError = class(Exception);
572
  EDXDrawError = class(Exception);
325
 
573
 
-
 
574
  { TD2D HW acceleration}
-
 
575
 
-
 
576
  TD2D = class;
-
 
577
 
-
 
578
  {  TTracerCollection  }
-
 
579
 
-
 
580
  TTraces = class;
-
 
581
 
326
  {  TCustomDXDraw  }
582
  {  TCustomDXDraw  }
327
 
583
 
-
 
584
  TD2DTextureFilter = (D2D_POINT, D2D_LINEAR, D2D_FLATCUBIC, D2D_GAUSSIANCUBIC, D2D_ANISOTROPIC);
-
 
585
 
-
 
586
 
328
  TDXDrawOption = (doFullScreen, doNoWindowChange, doAllowReboot, doWaitVBlank,
587
  TDXDrawOption = (doFullScreen, doNoWindowChange, doAllowReboot, doWaitVBlank,
329
    doAllowPalette256, doSystemMemory, doStretch, doCenter, doFlip,
588
    doAllowPalette256, doSystemMemory, doStretch, doCenter, doFlip,
-
 
589
    {$IFDEF D3D_deprecated}do3D, doDirectX7Mode,{$ENDIF} {$IFDEF D3DRM} doRetainedMode,{$ENDIF}
330
    do3D, doDirectX7Mode, doRetainedMode, doHardware, doSelectDriver, doZBuffer);
590
    doHardware, doSelectDriver, doZBuffer);
331
 
591
 
332
  TDXDrawOptions = set of TDXDrawOption;
592
  TDXDrawOptions = set of TDXDrawOption;
333
 
593
 
334
  TDXDrawNotifyType = (dxntDestroying, dxntInitializing, dxntInitialize, dxntInitializeSurface,
594
  TDXDrawNotifyType = (dxntDestroying, dxntInitializing, dxntInitialize, dxntInitializeSurface,
335
    dxntFinalize, dxntFinalizeSurface, dxntRestore, dxntSetSurfaceSize);
595
    dxntFinalize, dxntFinalizeSurface, dxntRestore, dxntSetSurfaceSize);
336
 
596
 
337
  TDXDrawNotifyEvent = procedure(Sender: TCustomDXDraw; NotifyType: TDXDrawNotifyType) of object;
597
  TDXDrawNotifyEvent = procedure(Sender: TCustomDXDraw; NotifyType: TDXDrawNotifyType) of object;
338
 
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
 
339
  TCustomDXDraw = class(TCustomControl)
609
  TCustomDXDraw = class(TCustomControl)
340
  private
610
  private
341
    FAutoInitialize: Boolean;
611
    FAutoInitialize: Boolean;
342
    FAutoSize: Boolean;
612
    FAutoSize: Boolean;
343
    FCalledDoInitialize: Boolean;
613
    FCalledDoInitialize: Boolean;
Line 362... Line 632...
362
    FDXDrawDriver: TObject;
632
    FDXDrawDriver: TObject;
363
    FDriver: PGUID;
633
    FDriver: PGUID;
364
    FDriverGUID: TGUID;
634
    FDriverGUID: TGUID;
365
    FDDraw: TDirectDraw;
635
    FDDraw: TDirectDraw;
366
    FDisplay: TDXDrawDisplay;
636
    FDisplay: TDXDrawDisplay;
-
 
637
    {$IFNDEF D3D_deprecated}
-
 
638
    FDeviceTypeSet: TD3DDeviceTypeSet;{$ENDIF}
-
 
639
    {$IFDEF _DMO_}FAdapters: TDirectXDriversEx;{$ENDIF}
367
    FClipper: TDirectDrawClipper;
640
    FClipper: TDirectDrawClipper;
368
    FPalette: TDirectDrawPalette;
641
    FPalette: TDirectDrawPalette;
369
    FPrimary: TDirectDrawSurface;
642
    FPrimary: TDirectDrawSurface;
370
    FSurface: TDirectDrawSurface;
643
    FSurface: TDirectDrawSurface;
371
    FSurfaceWidth: Integer;
644
    FSurfaceWidth: Integer;
372
    FSurfaceHeight: Integer;
645
    FSurfaceHeight: Integer;
373
    { Direct3D }
646
    { Direct3D }
-
 
647
    {$IFDEF D3D_deprecated}
374
    FD3D: IDirect3D;
648
    FD3D: IDirect3D;
375
    FD3D2: IDirect3D2;
649
    FD3D2: IDirect3D2;
376
    FD3D3: IDirect3D3;
650
    FD3D3: IDirect3D3;
-
 
651
    {$ENDIF}
377
    FD3D7: IDirect3D7;
652
    FD3D7: IDirect3D7;
-
 
653
    {$IFDEF D3D_deprecated}
378
    FD3DDevice: IDirect3DDevice;
654
    FD3DDevice: IDirect3DDevice;
379
    FD3DDevice2: IDirect3DDevice2;
655
    FD3DDevice2: IDirect3DDevice2;
380
    FD3DDevice3: IDirect3DDevice3;
656
    FD3DDevice3: IDirect3DDevice3;
-
 
657
    {$ENDIF}
381
    FD3DDevice7: IDirect3DDevice7;
658
    FD3DDevice7: IDirect3DDevice7;
-
 
659
{$IFDEF D3DRM}
382
    FD3DRM: IDirect3DRM;
660
    FD3DRM: IDirect3DRM;
383
    FD3DRM2: IDirect3DRM2;
661
    FD3DRM2: IDirect3DRM2;
384
    FD3DRM3: IDirect3DRM3;
662
    FD3DRM3: IDirect3DRM3;
385
    FD3DRMDevice: IDirect3DRMDevice;
663
    FD3DRMDevice: IDirect3DRMDevice;
386
    FD3DRMDevice2: IDirect3DRMDevice2;
664
    FD3DRMDevice2: IDirect3DRMDevice2;
387
    FD3DRMDevice3: IDirect3DRMDevice3;
665
    FD3DRMDevice3: IDirect3DRMDevice3;
388
    FCamera: IDirect3DRMFrame;
666
    FCamera: IDirect3DRMFrame;
389
    FScene: IDirect3DRMFrame;
667
    FScene: IDirect3DRMFrame;
390
    FViewport: IDirect3DRMViewport;
668
    FViewport: IDirect3DRMViewport;
-
 
669
{$ENDIF}
391
    FZBuffer: TDirectDrawSurface;
670
    FZBuffer: TDirectDrawSurface;
-
 
671
    FD2D: TD2D;
-
 
672
    FOnUpdateTextures: TOnUpdateTextures;
-
 
673
    FTraces: TTraces;
-
 
674
    FOnRender: TNotifyEvent;
392
    procedure FormWndProc(var Message: TMessage; DefWindowProc: TWndMethod);
675
    procedure FormWndProc(var Message: TMessage; DefWindowProc: TWndMethod);
393
    function GetCanDraw: Boolean;
676
    function GetCanDraw: Boolean; {$IFDEF VER9UP}inline;{$ENDIF}
394
    function GetCanPaletteAnimation: Boolean;
677
    function GetCanPaletteAnimation: Boolean;
395
    function GetSurfaceHeight: Integer;
678
    function GetSurfaceHeight: Integer;
396
    function GetSurfaceWidth: Integer;
679
    function GetSurfaceWidth: Integer;
397
    procedure NotifyEventList(NotifyType: TDXDrawNotifyType);
680
    procedure NotifyEventList(NotifyType: TDXDrawNotifyType);
398
    procedure SetAutoSize(Value: Boolean);
-
 
399
    procedure SetColorTable(const ColorTable: TRGBQuads);
681
    procedure SetColorTable(const ColorTable: TRGBQuads);
400
    procedure SetCooperativeLevel;
682
    procedure SetCooperativeLevel;
401
    procedure SetDisplay(Value: TDXDrawDisplay);
683
    procedure SetDisplay(Value: TDXDrawDisplay);
402
    procedure SetDriver(Value: PGUID);
684
    procedure SetDriver(Value: PGUID);
403
    procedure SetOptions(Value: TDXDrawOptions);
685
    procedure SetOptions(Value: TDXDrawOptions);
404
    procedure SetSurfaceHeight(Value: Integer);
686
    procedure SetSurfaceHeight(Value: Integer);
405
    procedure SetSurfaceWidth(Value: Integer);
687
    procedure SetSurfaceWidth(Value: Integer);
406
    function TryRestore: Boolean;
688
    function TryRestore: Boolean;
407
    procedure WMCreate(var Message: TMessage); message WM_CREATE;
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;
408
  protected
695
  protected
409
    procedure DoFinalize; virtual;
696
    procedure DoFinalize; virtual;
410
    procedure DoFinalizeSurface; virtual;
697
    procedure DoFinalizeSurface; virtual;
411
    procedure DoInitialize; virtual;
698
    procedure DoInitialize; virtual;
412
    procedure DoInitializeSurface; virtual;
699
    procedure DoInitializeSurface; virtual;
Line 414... Line 701...
414
    procedure DoRestoreSurface; virtual;
701
    procedure DoRestoreSurface; virtual;
415
    procedure Loaded; override;
702
    procedure Loaded; override;
416
    procedure Paint; override;
703
    procedure Paint; override;
417
    function PaletteChanged(Foreground: Boolean): Boolean; override;
704
    function PaletteChanged(Foreground: Boolean): Boolean; override;
418
    procedure SetParent(AParent: TWinControl); 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;
419
  public
709
  public
420
    ColorTable: TRGBQuads;
710
    ColorTable: TRGBQuads;
421
    DefColorTable: TRGBQuads;
711
    DefColorTable: TRGBQuads;
-
 
712
    //
-
 
713
    function Fade2Black(colorfrom: Integer): Longint;
-
 
714
    function Fade2White(colorfrom: Integer): Longint;
-
 
715
    //
422
    constructor Create(AOwner: TComponent); override;
716
    constructor Create(AOwner: TComponent); override;
423
    destructor Destroy; override;
717
    destructor Destroy; override;
424
    class function Drivers: TDirectXDrivers;
718
    class function Drivers: TDirectXDrivers;
-
 
719
    {$IFDEF _DMO_}class function DriversEx: TDirectXDriversEx;{$ENDIF}
425
    procedure Finalize;
720
    procedure Finalize;
426
    procedure Flip;
721
    procedure Flip;
427
    procedure Initialize;
722
    procedure Initialize;
428
    procedure Render;
723
    procedure Render(LagCount: Integer{$IFDEF VER4UP} = 0{$ENDIF});
429
    procedure Restore;
724
    procedure Restore;
430
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
725
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
431
    procedure SetSize(ASurfaceWidth, ASurfaceHeight: Integer);
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;
432
    procedure UpdatePalette;
743
    procedure UpdatePalette;
433
    procedure RegisterNotifyEvent(NotifyEvent: TDXDrawNotifyEvent);
744
    procedure RegisterNotifyEvent(NotifyEvent: TDXDrawNotifyEvent);
434
    procedure UnRegisterNotifyEvent(NotifyEvent: TDXDrawNotifyEvent);
745
    procedure UnRegisterNotifyEvent(NotifyEvent: TDXDrawNotifyEvent);
435
 
-
 
436
    property AutoInitialize: Boolean read FAutoInitialize write FAutoInitialize;
746
    property AutoInitialize: Boolean read FAutoInitialize write FAutoInitialize;
437
    property AutoSize: Boolean read FAutoSize write SetAutoSize;
747
    property AutoSize: Boolean read FAutoSize write SetAutoSize;
438
    property Camera: IDirect3DRMFrame read FCamera;
748
{$IFDEF D3DRM}property Camera: IDirect3DRMFrame read FCamera; {$ENDIF}
439
    property CanDraw: Boolean read GetCanDraw;
749
    property CanDraw: Boolean read GetCanDraw;
440
    property CanPaletteAnimation: Boolean read GetCanPaletteAnimation;
750
    property CanPaletteAnimation: Boolean read GetCanPaletteAnimation;
441
    property Clipper: TDirectDrawClipper read FClipper;
751
    property Clipper: TDirectDrawClipper read FClipper;
442
    property Color;
752
    property Color;
-
 
753
    {$IFDEF D3D_deprecated}
443
    property D3D: IDirect3D read FD3D;
754
    property D3D: IDirect3D read FD3D;
444
    property D3D2: IDirect3D2 read FD3D2;
755
    property D3D2: IDirect3D2 read FD3D2;
445
    property D3D3: IDirect3D3 read FD3D3;
756
    property D3D3: IDirect3D3 read FD3D3;
-
 
757
    {$ENDIF}
446
    property D3D7: IDirect3D7 read FD3D7;
758
    property D3D7: IDirect3D7 read FD3D7;
-
 
759
    {$IFDEF D3D_deprecated}
447
    property D3DDevice: IDirect3DDevice read FD3DDevice;
760
    property D3DDevice: IDirect3DDevice read FD3DDevice;
448
    property D3DDevice2: IDirect3DDevice2 read FD3DDevice2;
761
    property D3DDevice2: IDirect3DDevice2 read FD3DDevice2;
449
    property D3DDevice3: IDirect3DDevice3 read FD3DDevice3;
762
    property D3DDevice3: IDirect3DDevice3 read FD3DDevice3;
-
 
763
    {$ENDIF}
450
    property D3DDevice7: IDirect3DDevice7 read FD3DDevice7;
764
    property D3DDevice7: IDirect3DDevice7 read FD3DDevice7;
-
 
765
    {$IFNDEF D3D_deprecated}
-
 
766
    property D3DDeviceTypeSet: TD3DDeviceTypeSet read FDeviceTypeSet;{$ENDIF}
-
 
767
{$IFDEF D3DRM}
451
    property D3DRM: IDirect3DRM read FD3DRM;
768
    property D3DRM: IDirect3DRM read FD3DRM;
452
    property D3DRM2: IDirect3DRM2 read FD3DRM2;
769
    property D3DRM2: IDirect3DRM2 read FD3DRM2;
453
    property D3DRM3: IDirect3DRM3 read FD3DRM3;
770
    property D3DRM3: IDirect3DRM3 read FD3DRM3;
454
    property D3DRMDevice: IDirect3DRMDevice read FD3DRMDevice;
771
    property D3DRMDevice: IDirect3DRMDevice read FD3DRMDevice;
455
    property D3DRMDevice2: IDirect3DRMDevice2 read FD3DRMDevice2;
772
    property D3DRMDevice2: IDirect3DRMDevice2 read FD3DRMDevice2;
456
    property D3DRMDevice3: IDirect3DRMDevice3 read FD3DRMDevice3;
773
    property D3DRMDevice3: IDirect3DRMDevice3 read FD3DRMDevice3;
-
 
774
{$ENDIF}
457
    property DDraw: TDirectDraw read FDDraw;
775
    property DDraw: TDirectDraw read FDDraw;
458
    property Display: TDXDrawDisplay read FDisplay write SetDisplay;
776
    property Display: TDXDrawDisplay read FDisplay write SetDisplay;
-
 
777
    {$IFDEF _DMO_}property Adapter: TDirectXDriversEx read FAdapters write FAdapters;{$ENDIF}
459
    property Driver: PGUID read FDriver write SetDriver;
778
    property Driver: PGUID read FDriver write SetDriver;
460
    property Initialized: Boolean read FInitialized;
779
    property Initialized: Boolean read FInitialized;
461
    property NowOptions: TDXDrawOptions read FNowOptions;
780
    property NowOptions: TDXDrawOptions read FNowOptions;
462
    property OnFinalize: TNotifyEvent read FOnFinalize write FOnFinalize;
781
    property OnFinalize: TNotifyEvent read FOnFinalize write FOnFinalize;
463
    property OnFinalizeSurface: TNotifyEvent read FOnFinalizeSurface write FOnFinalizeSurface;
782
    property OnFinalizeSurface: TNotifyEvent read FOnFinalizeSurface write FOnFinalizeSurface;
Line 466... Line 785...
466
    property OnInitializing: TNotifyEvent read FOnInitializing write FOnInitializing;
785
    property OnInitializing: TNotifyEvent read FOnInitializing write FOnInitializing;
467
    property OnRestoreSurface: TNotifyEvent read FOnRestoreSurface write FOnRestoreSurface;
786
    property OnRestoreSurface: TNotifyEvent read FOnRestoreSurface write FOnRestoreSurface;
468
    property Options: TDXDrawOptions read FOptions write SetOptions;
787
    property Options: TDXDrawOptions read FOptions write SetOptions;
469
    property Palette: TDirectDrawPalette read FPalette;
788
    property Palette: TDirectDrawPalette read FPalette;
470
    property Primary: TDirectDrawSurface read FPrimary;
789
    property Primary: TDirectDrawSurface read FPrimary;
471
    property Scene: IDirect3DRMFrame read FScene;
790
{$IFDEF D3DRM}property Scene: IDirect3DRMFrame read FScene; {$ENDIF}
472
    property Surface: TDirectDrawSurface read FSurface;
791
    property Surface: TDirectDrawSurface read FSurface;
473
    property SurfaceHeight: Integer read GetSurfaceHeight write SetSurfaceHeight default 480;
792
    property SurfaceHeight: Integer read GetSurfaceHeight write SetSurfaceHeight default 480;
474
    property SurfaceWidth: Integer read GetSurfaceWidth write SetSurfaceWidth default 640;
793
    property SurfaceWidth: Integer read GetSurfaceWidth write SetSurfaceWidth default 640;
475
    property Viewport: IDirect3DRMViewport read FViewport;
794
{$IFDEF D3DRM}property Viewport: IDirect3DRMViewport read FViewport; {$ENDIF}
476
    property ZBuffer: TDirectDrawSurface read FZBuffer;
795
    property ZBuffer: TDirectDrawSurface read FZBuffer;
-
 
796
    property D2D1: TD2D read FD2D; {public object is here}
-
 
797
    property Traces: TTraces read FTraces write SetTraces;
477
  end;
798
  end;
478
 
799
 
479
  {  TDXDraw  }
800
  {  TDXDraw  }
480
 
801
 
481
  TDXDraw = class(TCustomDXDraw)
802
  TDXDraw = class(TCustomDXDraw)
482
  published
803
  published
-
 
804
    {$IFDEF _DMO_}property Adapter;{$ENDIF}
483
    property AutoInitialize;
805
    property AutoInitialize;
484
    property AutoSize;
806
    property AutoSize;
485
    property Color;
807
    property Color;
486
    property Display;
808
    property Display;
487
    property Options;
809
    property Options;
Line 491... Line 813...
491
    property OnFinalizeSurface;
813
    property OnFinalizeSurface;
492
    property OnInitialize;
814
    property OnInitialize;
493
    property OnInitializeSurface;
815
    property OnInitializeSurface;
494
    property OnInitializing;
816
    property OnInitializing;
495
    property OnRestoreSurface;
817
    property OnRestoreSurface;
-
 
818
    property OnUpdateTextures;
-
 
819
    property OnRender;
496
 
820
 
497
    property Align;
821
    property Align;
498
    {$IFDEF DelphiX_Spt4}property Anchors;{$ENDIF}
822
{$IFDEF VER4UP}property Anchors; {$ENDIF}
499
    {$IFDEF DelphiX_Spt4}property Constraints;{$ENDIF}
823
{$IFDEF VER4UP}property Constraints; {$ENDIF}
500
    property DragCursor;
824
    property DragCursor;
501
    property DragMode;
825
    property DragMode;
502
    property Enabled;
826
    property Enabled;
503
    property ParentShowHint;
827
    property ParentShowHint;
504
    property PopupMenu;
828
    property PopupMenu;
505
    property ShowHint;
829
    property ShowHint;
506
    property TabOrder;
830
    property TabOrder;
507
    property TabStop;
831
    property TabStop;
-
 
832
    property Traces;
508
    property Visible;
833
    property Visible;
509
    property OnClick;
834
    property OnClick;
510
    property OnDblClick;
835
    property OnDblClick;
511
    property OnDragDrop;
836
    property OnDragDrop;
512
    property OnDragOver;
837
    property OnDragOver;
Line 517... Line 842...
517
    property OnKeyPress;
842
    property OnKeyPress;
518
    property OnKeyUp;
843
    property OnKeyUp;
519
    property OnMouseDown;
844
    property OnMouseDown;
520
    property OnMouseMove;
845
    property OnMouseMove;
521
    property OnMouseUp;
846
    property OnMouseUp;
-
 
847
{$IFDEF VER9UP}
-
 
848
    property OnMouseWheel;
-
 
849
    property OnMouseWheelUp;
-
 
850
    property OnMouseWheelDown;
-
 
851
{$ENDIF}
522
    {$IFDEF DelphiX_Spt4}property OnResize;{$ENDIF}
852
{$IFDEF VER4UP}property OnResize; {$ENDIF}
523
    property OnStartDrag;
853
    property OnStartDrag;
524
  end;
854
  end;
525
 
855
 
526
  {  EDX3DError  }
856
  {  EDX3DError  }
527
 
857
 
528
  EDX3DError = class(Exception);
858
  EDX3DError = class(Exception);
529
 
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
 
530
  {  TCustomDX3D  }
1168
  {  TCustomDX3D  }
531
 
1169
 
532
  TDX3DOption = (toRetainedMode, toSystemMemory, toHardware, toSelectDriver, toZBuffer);
1170
  TDX3DOption = (toRetainedMode, toSystemMemory, toHardware, toSelectDriver, toZBuffer);
533
 
1171
 
534
  TDX3DOptions = set of TDX3DOption;
1172
  TDX3DOptions = set of TDX3DOption;
535
 
1173
 
536
  TCustomDX3D = class(TComponent)
1174
  TCustomDX3D = class(TComponent)
537
  private
1175
  private
538
    FAutoSize: Boolean;
1176
    FAutoSize: Boolean;
539
    FCamera: IDirect3DRMFrame;
1177
{$IFDEF D3DRM}FCamera: IDirect3DRMFrame; {$ENDIF}
-
 
1178
    {$IFDEF D3D_deprecated}
540
    FD3D: IDirect3D;
1179
    FD3D: IDirect3D;
541
    FD3D2: IDirect3D2;
1180
    FD3D2: IDirect3D2;
542
    FD3D3: IDirect3D3;
1181
    FD3D3: IDirect3D3;
-
 
1182
    {$ENDIF}
543
    FD3D7: IDirect3D7;
1183
    FD3D7: IDirect3D7;
-
 
1184
    {$IFDEF D3D_deprecated}
544
    FD3DDevice: IDirect3DDevice;
1185
    FD3DDevice: IDirect3DDevice;
545
    FD3DDevice2: IDirect3DDevice2;
1186
    FD3DDevice2: IDirect3DDevice2;
546
    FD3DDevice3: IDirect3DDevice3;
1187
    FD3DDevice3: IDirect3DDevice3;
-
 
1188
    {$ENDIF}
547
    FD3DDevice7: IDirect3DDevice7;
1189
    FD3DDevice7: IDirect3DDevice7;
-
 
1190
{$IFDEF D3DRM}
548
    FD3DRM: IDirect3DRM;
1191
    FD3DRM: IDirect3DRM;
549
    FD3DRM2: IDirect3DRM2;
1192
    FD3DRM2: IDirect3DRM2;
550
    FD3DRM3: IDirect3DRM3;
1193
    FD3DRM3: IDirect3DRM3;
551
    FD3DRMDevice: IDirect3DRMDevice;
1194
    FD3DRMDevice: IDirect3DRMDevice;
552
    FD3DRMDevice2: IDirect3DRMDevice2;
1195
    FD3DRMDevice2: IDirect3DRMDevice2;
553
    FD3DRMDevice3: IDirect3DRMDevice3;
1196
    FD3DRMDevice3: IDirect3DRMDevice3;
-
 
1197
{$ENDIF}
554
    FDXDraw: TCustomDXDraw;
1198
    FDXDraw: TCustomDXDraw;
555
    FInitFlag: Boolean;
1199
    FInitFlag: Boolean;
556
    FInitialized: Boolean;
1200
    FInitialized: Boolean;
557
    FNowOptions: TDX3DOptions;
1201
    FNowOptions: TDX3DOptions;
558
    FOnFinalize: TNotifyEvent;
1202
    FOnFinalize: TNotifyEvent;
559
    FOnInitialize: TNotifyEvent;
1203
    FOnInitialize: TNotifyEvent;
560
    FOptions: TDX3DOptions;
1204
    FOptions: TDX3DOptions;
561
    FScene: IDirect3DRMFrame;
1205
{$IFDEF D3DRM}FScene: IDirect3DRMFrame; {$ENDIF}
562
    FSurface: TDirectDrawSurface;
1206
    FSurface: TDirectDrawSurface;
563
    FSurfaceHeight: Integer;
1207
    FSurfaceHeight: Integer;
564
    FSurfaceWidth: Integer;
1208
    FSurfaceWidth: Integer;
565
    FViewport: IDirect3DRMViewport;
1209
{$IFDEF D3DRM}FViewport: IDirect3DRMViewport; {$ENDIF}
566
    FZBuffer: TDirectDrawSurface;
1210
    FZBuffer: TDirectDrawSurface;
567
    procedure Finalize;
1211
    procedure Finalize;
568
    procedure Initialize;
1212
    procedure Initialize;
569
    procedure DXDrawNotifyEvent(Sender: TCustomDXDraw; NotifyType: TDXDrawNotifyType);
1213
    procedure DXDrawNotifyEvent(Sender: TCustomDXDraw; NotifyType: TDXDrawNotifyType);
570
    function GetCanDraw: Boolean;
1214
    function GetCanDraw: Boolean;
571
    function GetSurfaceHeight: Integer;
1215
    function GetSurfaceHeight: Integer;
572
    function GetSurfaceWidth: Integer;
1216
    function GetSurfaceWidth: Integer;
573
    procedure SetAutoSize(Value: Boolean);
1217
    procedure SetAutoSize(Value: Boolean);
574
    procedure SetDXDraw(Value: TCustomDXDraw);
1218
    procedure SetDXDraw(Value: TCustomDXDraw);
575
    procedure SetOptions(Value: TDX3DOptions);
1219
    procedure SetOptions(Value: TDX3DOptions); virtual; {TridenT}
576
    procedure SetSurfaceHeight(Value: Integer);
1220
    procedure SetSurfaceHeight(Value: Integer);
577
    procedure SetSurfaceWidth(Value: Integer);
1221
    procedure SetSurfaceWidth(Value: Integer);
578
  protected
1222
  protected
579
    procedure DoFinalize; virtual;
1223
    procedure DoFinalize; virtual;
580
    procedure DoInitialize; virtual;
1224
    procedure DoInitialize; virtual;
Line 583... Line 1227...
583
    constructor Create(AOwner: TComponent); override;
1227
    constructor Create(AOwner: TComponent); override;
584
    destructor Destroy; override;
1228
    destructor Destroy; override;
585
    procedure Render;
1229
    procedure Render;
586
    procedure SetSize(ASurfaceWidth, ASurfaceHeight: Integer);
1230
    procedure SetSize(ASurfaceWidth, ASurfaceHeight: Integer);
587
    property AutoSize: Boolean read FAutoSize write SetAutoSize;
1231
    property AutoSize: Boolean read FAutoSize write SetAutoSize;
588
    property Camera: IDirect3DRMFrame read FCamera;
1232
{$IFDEF D3DRM}property Camera: IDirect3DRMFrame read FCamera; {$ENDIF}
589
    property CanDraw: Boolean read GetCanDraw;
1233
    property CanDraw: Boolean read GetCanDraw;
590
    property D3D: IDirect3D read FD3D;
1234
    property D3D: IDirect3D read FD3D;
591
    property D3D2: IDirect3D2 read FD3D2;
1235
    property D3D2: IDirect3D2 read FD3D2;
592
    property D3D3: IDirect3D3 read FD3D3;
1236
    property D3D3: IDirect3D3 read FD3D3;
593
    property D3D7: IDirect3D7 read FD3D7;
1237
    property D3D7: IDirect3D7 read FD3D7;
-
 
1238
    {$IFDEF D3D_deprecated}
594
    property D3DDevice: IDirect3DDevice read FD3DDevice;
1239
    property D3DDevice: IDirect3DDevice read FD3DDevice;
595
    property D3DDevice2: IDirect3DDevice2 read FD3DDevice2;
1240
    property D3DDevice2: IDirect3DDevice2 read FD3DDevice2;
596
    property D3DDevice3: IDirect3DDevice3 read FD3DDevice3;
1241
    property D3DDevice3: IDirect3DDevice3 read FD3DDevice3;
-
 
1242
    {$ENDIF}
597
    property D3DDevice7: IDirect3DDevice7 read FD3DDevice7;
1243
    property D3DDevice7: IDirect3DDevice7 read FD3DDevice7;
-
 
1244
{$IFDEF D3DRM}
598
    property D3DRM: IDirect3DRM read FD3DRM;
1245
    property D3DRM: IDirect3DRM read FD3DRM;
599
    property D3DRM2: IDirect3DRM2 read FD3DRM2;
1246
    property D3DRM2: IDirect3DRM2 read FD3DRM2;
600
    property D3DRM3: IDirect3DRM3 read FD3DRM3;
1247
    property D3DRM3: IDirect3DRM3 read FD3DRM3;
601
    property D3DRMDevice: IDirect3DRMDevice read FD3DRMDevice;
1248
    property D3DRMDevice: IDirect3DRMDevice read FD3DRMDevice;
602
    property D3DRMDevice2: IDirect3DRMDevice2 read FD3DRMDevice2;
1249
    property D3DRMDevice2: IDirect3DRMDevice2 read FD3DRMDevice2;
603
    property D3DRMDevice3: IDirect3DRMDevice3 read FD3DRMDevice3;
1250
    property D3DRMDevice3: IDirect3DRMDevice3 read FD3DRMDevice3;
-
 
1251
{$ENDIF}
604
    property DXDraw: TCustomDXDraw read FDXDraw write SetDXDraw;
1252
    property DXDraw: TCustomDXDraw read FDXDraw write SetDXDraw;
605
    property Initialized: Boolean read FInitialized;
1253
    property Initialized: Boolean read FInitialized;
606
    property NowOptions: TDX3DOptions read FNowOptions;
1254
    property NowOptions: TDX3DOptions read FNowOptions;
607
    property OnFinalize: TNotifyEvent read FOnFinalize write FOnFinalize;
1255
    property OnFinalize: TNotifyEvent read FOnFinalize write FOnFinalize;
608
    property OnInitialize: TNotifyEvent read FOnInitialize write FOnInitialize;
1256
    property OnInitialize: TNotifyEvent read FOnInitialize write FOnInitialize;
609
    property Options: TDX3DOptions read FOptions write SetOptions;
1257
    property Options: TDX3DOptions read FOptions write SetOptions;
610
    property Scene: IDirect3DRMFrame read FScene;
1258
{$IFDEF D3DRM}property Scene: IDirect3DRMFrame read FScene; {$ENDIF}
611
    property Surface: TDirectDrawSurface read FSurface;
1259
    property Surface: TDirectDrawSurface read FSurface;
612
    property SurfaceHeight: Integer read GetSurfaceHeight write SetSurfaceHeight default 480;
1260
    property SurfaceHeight: Integer read GetSurfaceHeight write SetSurfaceHeight default 480;
613
    property SurfaceWidth: Integer read GetSurfaceWidth write SetSurfaceWidth default 640;
1261
    property SurfaceWidth: Integer read GetSurfaceWidth write SetSurfaceWidth default 640;
614
    property Viewport: IDirect3DRMViewport read FViewport;
1262
{$IFDEF D3DRM}property Viewport: IDirect3DRMViewport read FViewport; {$ENDIF}
615
    property ZBuffer: TDirectDrawSurface read FZBuffer;
1263
    property ZBuffer: TDirectDrawSurface read FZBuffer;
616
  end;
1264
  end;
617
 
1265
 
618
  {  TDX3D  }
1266
  {  TDX3D  }
619
 
1267
 
Line 625... Line 1273...
625
    property SurfaceHeight;
1273
    property SurfaceHeight;
626
    property SurfaceWidth;
1274
    property SurfaceWidth;
627
    property OnFinalize;
1275
    property OnFinalize;
628
    property OnInitialize;
1276
    property OnInitialize;
629
  end;
1277
  end;
-
 
1278
{$ENDIF}
630
 
1279
 
631
  {  EDirect3DTextureError  }
1280
  {  EDirect3DTextureError  }
632
 
1281
 
633
  EDirect3DTextureError = class(Exception);
1282
  EDirect3DTextureError = class(Exception);
634
 
1283
 
635
  {  TDirect3DTexture  }
1284
  {  TDirect3DTexture  }
636
 
1285
 
637
  TDirect3DTexture = class
1286
  TDirect3DTexture = class
638
  private
1287
  private
639
    FBitCount: DWORD;
1288
    FBitCount: DWORD;
Line 642... Line 1291...
642
    FFormat: TDDSurfaceDesc;
1291
    FFormat: TDDSurfaceDesc;
643
    FGraphic: TGraphic;
1292
    FGraphic: TGraphic;
644
    FHandle: TD3DTextureHandle;
1293
    FHandle: TD3DTextureHandle;
645
    FPaletteEntries: TPaletteEntries;
1294
    FPaletteEntries: TPaletteEntries;
646
    FSurface: TDirectDrawSurface;
1295
    FSurface: TDirectDrawSurface;
647
    FTexture: IDirect3DTexture;
1296
    FTexture: {$IFDEF D3D_deprecated}IDirect3DTexture{$ELSE}IDirect3DTexture2{$ENDIF};
648
    FTransparentColor: TColor;
1297
    FTransparentColor: TColor;
649
    procedure Clear;
1298
    procedure Clear;
650
    procedure DXDrawNotifyEvent(Sender: TCustomDXDraw; NotifyType: TDXDrawNotifyType);
1299
    procedure DXDrawNotifyEvent(Sender: TCustomDXDraw; NotifyType: TDXDrawNotifyType);
651
    function GetHandle: TD3DTextureHandle;
1300
    function GetHandle: TD3DTextureHandle;
652
    function GetSurface: TDirectDrawSurface;
1301
    function GetSurface: TDirectDrawSurface;
653
    function GetTexture: IDirect3DTexture;
1302
    function GetTexture: {$IFDEF D3D_deprecated}IDirect3DTexture{$ELSE}IDirect3DTexture2{$ENDIF};
654
    procedure SetTransparentColor(Value: TColor);
1303
    procedure SetTransparentColor(Value: TColor);
655
  public
1304
  public
656
    constructor Create(Graphic: TGraphic; DXDraw: TComponent);
1305
    constructor Create(Graphic: TGraphic; DXDraw: TComponent);
657
    destructor Destroy; override;
1306
    destructor Destroy; override;
658
    procedure Restore;
1307
    procedure Restore;
659
    property Handle: TD3DTextureHandle read GetHandle;
1308
    property Handle: TD3DTextureHandle read GetHandle;
660
    property Surface: TDirectDrawSurface read GetSurface;
1309
    property Surface: TDirectDrawSurface read GetSurface;
661
    property TransparentColor: TColor read FTransparentColor write SetTransparentColor;
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;
662
    property Texture: IDirect3DTexture read GetTexture;
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;
663
  end;
1436
  end;
664
 
1437
 
665
  {  TDirect3DTexture2  }
1438
  {  TDirect3DTexture2  }
666
 
1439
 
667
  TDirect3DTexture2 = class
1440
  TDirect3DTexture2 = class
Line 682... Line 1455...
682
    FNeedLoadTexture: Boolean;
1455
    FNeedLoadTexture: Boolean;
683
    FEnumTextureFormatFlag: Boolean;
1456
    FEnumTextureFormatFlag: Boolean;
684
    FD3DDevDesc: TD3DDeviceDesc;
1457
    FD3DDevDesc: TD3DDeviceDesc;
685
    procedure DXDrawNotifyEvent(Sender: TCustomDXDraw; NotifyType: TDXDrawNotifyType);
1458
    procedure DXDrawNotifyEvent(Sender: TCustomDXDraw; NotifyType: TDXDrawNotifyType);
686
    procedure SetDXDraw(ADXDraw: TCustomDXDraw);
1459
    procedure SetDXDraw(ADXDraw: TCustomDXDraw);
687
    procedure LoadSubTexture(Dest: IDirectDrawSurface4; SrcImage: TDXTextureImage);
1460
    procedure LoadSubTexture(Dest: {$IFDEF D3D_deprecated}IDirectDrawSurface4{$ELSE}IDirectDrawSurface7{$ENDIF}; SrcImage: TDXTextureImage);
688
    procedure SetColorKey;
1461
    procedure SetColorKey;
689
    procedure SetDIB(DIB: TDIB);
1462
    procedure SetDIB(DIB: TDIB);
690
    function GetIsMipmap: Boolean;
1463
    function GetIsMipmap: Boolean; {$IFDEF VER9UP}inline;{$ENDIF}
691
    function GetSurface: TDirectDrawSurface;
1464
    function GetSurface: TDirectDrawSurface; {$IFDEF VER9UP}inline;{$ENDIF}
692
    function GetTransparent: Boolean;
1465
    function GetTransparent: Boolean; {$IFDEF VER9UP}inline;{$ENDIF}
693
    procedure SetTransparent(Value: Boolean);
1466
    procedure SetTransparent(Value: Boolean); {$IFDEF VER9UP}inline;{$ENDIF}
694
    procedure SetTransparentColor(Value: TColorRef);
1467
    procedure SetTransparentColor(Value: TColorRef); {$IFDEF VER9UP}inline;{$ENDIF}
-
 
1468
    function GetHeight: Integer;
-
 
1469
    function GetWidth: Integer;
695
  protected
1470
  protected
696
    procedure DoRestoreSurface; virtual;
1471
    procedure DoRestoreSurface; virtual;
697
  public
1472
  public
698
    constructor Create(ADXDraw: TCustomDXDraw; Graphic: TObject; AutoFreeGraphic: Boolean);
1473
    constructor Create(ADXDraw: TCustomDXDraw; Graphic: TObject; AutoFreeGraphic: Boolean{$IFDEF VER4UP} = False{$ENDIF});
699
    constructor CreateFromFile(ADXDraw: TCustomDXDraw; const FileName: string);
1474
    constructor CreateFromFile(ADXDraw: TCustomDXDraw; const FileName: string);
700
    constructor CreateVideoTexture(ADXDraw: TCustomDXDraw);
1475
    constructor CreateVideoTexture(ADXDraw: TCustomDXDraw);
701
    destructor Destroy; override;
1476
    destructor Destroy; override;
702
    procedure Finalize;
1477
    procedure Finalize;
703
    procedure Load;
1478
    procedure Load;
704
    procedure Initialize;
1479
    procedure Initialize;
-
 
1480
    property Height: Integer read GetHeight;
-
 
1481
    property Width: Integer read GetWidth;
705
    property IsMipmap: Boolean read GetIsMipmap;
1482
    property IsMipmap: Boolean read GetIsMipmap;
706
    property Surface: TDirectDrawSurface read GetSurface;
1483
    property Surface: TDirectDrawSurface read GetSurface;
707
    property TextureFormat: TDDSurfaceDesc2 read FTextureFormat write FTextureFormat;
1484
    property TextureFormat: TDDSurfaceDesc2 read FTextureFormat write FTextureFormat;
708
    property Transparent: Boolean read GetTransparent write SetTransparent;
1485
    property Transparent: Boolean read GetTransparent write SetTransparent;
709
    property TransparentColor: TColorRef read FTransparentColor write SetTransparentColor;
1486
    property TransparentColor: TColorRef read FTransparentColor write SetTransparentColor;
710
    property OnRestoreSurface: TNotifyEvent read FOnRestoreSurface write FOnRestoreSurface;
1487
    property OnRestoreSurface: TNotifyEvent read FOnRestoreSurface write FOnRestoreSurface;
711
  end;
1488
  end;
712
 
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}
713
  {  EDirect3DRMUserVisualError  }
1587
  {  EDirect3DRMUserVisualError  }
714
 
1588
 
715
  EDirect3DRMUserVisualError = class(Exception);
1589
  EDirect3DRMUserVisualError = class(Exception);
716
 
1590
 
717
  {  TDirect3DRMUserVisual  }
1591
  {  TDirect3DRMUserVisual  }
Line 725... Line 1599...
725
  public
1599
  public
726
    constructor Create(D3DRM: IDirect3DRM);
1600
    constructor Create(D3DRM: IDirect3DRM);
727
    destructor Destroy; override;
1601
    destructor Destroy; override;
728
    property UserVisual: IDirect3DRMUserVisual read FUserVisual;
1602
    property UserVisual: IDirect3DRMUserVisual read FUserVisual;
729
  end;
1603
  end;
-
 
1604
{$ENDIF}
730
 
1605
 
731
  {  EPictureCollectionError  }
1606
  {  EPictureCollectionError  }
732
 
1607
 
733
  EPictureCollectionError = class(Exception);
1608
  EPictureCollectionError = class(Exception);
734
 
1609
 
Line 754... Line 1629...
754
    procedure Initialize;
1629
    procedure Initialize;
755
    function GetHeight: Integer;
1630
    function GetHeight: Integer;
756
    function GetPictureCollection: TPictureCollection;
1631
    function GetPictureCollection: TPictureCollection;
757
    function GetPatternRect(Index: Integer): TRect;
1632
    function GetPatternRect(Index: Integer): TRect;
758
    function GetPatternSurface(Index: Integer): TDirectDrawSurface;
1633
    function GetPatternSurface(Index: Integer): TDirectDrawSurface;
759
    function GetPatternCount: Integer;
1634
    function GetPatternCount: Integer; {$IFDEF VER9UP}inline;{$ENDIF}
760
    function GetWidth: Integer;
1635
    function GetWidth: Integer;
761
    procedure SetPicture(Value: TPicture);
1636
    procedure SetPicture(Value: TPicture);
762
    procedure SetTransparentColor(Value: TColor);
1637
    procedure SetTransparentColor(Value: TColor);
763
  public
1638
  public
764
    constructor Create(Collection: TCollection); override;
1639
    constructor Create(Collection: TCollection); override;
765
    destructor Destroy; override;
1640
    destructor Destroy; override;
-
 
1641
    procedure UpdateTag;
766
    procedure Assign(Source: TPersistent); override;
1642
    procedure Assign(Source: TPersistent); override;
767
    procedure Draw(Dest: TDirectDrawSurface; X, Y: Integer; PatternIndex: Integer);
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);
768
    procedure StretchDraw(Dest: TDirectDrawSurface; const DestRect: TRect; PatternIndex: Integer);
1657
    procedure StretchDraw(Dest: TDirectDrawSurface; const DestRect: TRect; PatternIndex: Integer);
769
    procedure DrawAdd(Dest: TDirectDrawSurface; const DestRect: TRect; PatternIndex: Integer;
1658
    procedure DrawAdd(Dest: TDirectDrawSurface; const DestRect: TRect; PatternIndex: Integer;
770
      Alpha: Integer{$IFDEF DelphiX_Spt4}=255{$ENDIF});
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});
771
    procedure DrawAlpha(Dest: TDirectDrawSurface; const DestRect: TRect; PatternIndex: Integer;
1662
    procedure DrawAlpha(Dest: TDirectDrawSurface; const DestRect: TRect; PatternIndex: Integer;
772
      Alpha: 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});
773
    procedure DrawSub(Dest: TDirectDrawSurface; const DestRect: TRect; PatternIndex: Integer;
1666
    procedure DrawSub(Dest: TDirectDrawSurface; const DestRect: TRect; PatternIndex: Integer;
774
      Alpha: Integer{$IFDEF DelphiX_Spt4}=255{$ENDIF});
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}
775
    procedure DrawRotate(Dest: TDirectDrawSurface; X, Y, Width, Height: Integer; PatternIndex: Integer;
1671
    procedure DrawRotate(Dest: TDirectDrawSurface; X, Y, Width, Height: Integer; PatternIndex: Integer;
776
      CenterX, CenterY: Double; Angle: Integer);
1672
      CenterX, CenterY: Double; Angle: single);
777
    procedure DrawRotateAdd(Dest: TDirectDrawSurface; X, Y, Width, Height: Integer; PatternIndex: Integer;
1673
    procedure DrawRotateAdd(Dest: TDirectDrawSurface; X, Y, Width, Height: Integer; PatternIndex: Integer;
778
      CenterX, CenterY: Double; Angle: Integer;
1674
      CenterX, CenterY: Double; Angle: single;
779
      Alpha: Integer{$IFDEF DelphiX_Spt4}=255{$ENDIF});
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});
780
    procedure DrawRotateAlpha(Dest: TDirectDrawSurface; X, Y, Width, Height: Integer; PatternIndex: Integer;
1679
    procedure DrawRotateAlpha(Dest: TDirectDrawSurface; X, Y, Width, Height: Integer; PatternIndex: Integer;
781
      CenterX, CenterY: Double; Angle: Integer;
1680
      CenterX, CenterY: Double; Angle: single;
782
      Alpha: Integer);
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});
783
    procedure DrawRotateSub(Dest: TDirectDrawSurface; X, Y, Width, Height: Integer; PatternIndex: Integer;
1685
    procedure DrawRotateSub(Dest: TDirectDrawSurface; X, Y, Width, Height: Integer; PatternIndex: Integer;
784
      CenterX, CenterY: Double; Angle: Integer;
1686
      CenterX, CenterY: Double; Angle: single;
785
      Alpha: Integer{$IFDEF DelphiX_Spt4}=255{$ENDIF});
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}
786
    procedure DrawWaveX(Dest: TDirectDrawSurface; X, Y, Width, Height: Integer; PatternIndex: Integer;
1692
    procedure DrawWaveX(Dest: TDirectDrawSurface; X, Y, Width, Height: Integer; PatternIndex: Integer;
787
      amp, Len, ph: Integer);
1693
      amp, Len, ph: Integer);
788
    procedure DrawWaveXAdd(Dest: TDirectDrawSurface; X, Y, Width, Height: Integer; PatternIndex: Integer;
1694
    procedure DrawWaveXAdd(Dest: TDirectDrawSurface; X, Y, Width, Height: Integer; PatternIndex: Integer;
789
      amp, Len, ph: Integer; Alpha: Integer{$IFDEF DelphiX_Spt4}=255{$ENDIF});
1695
      amp, Len, ph: Integer; Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF});
790
    procedure DrawWaveXAlpha(Dest: TDirectDrawSurface; X, Y, Width, Height, PatternIndex: Integer;
1696
    procedure DrawWaveXAlpha(Dest: TDirectDrawSurface; X, Y, Width, Height, PatternIndex: Integer;
791
      amp, Len, ph: Integer; Alpha: Integer);
1697
      amp, Len, ph: Integer; Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF});
792
    procedure DrawWaveXSub(Dest: TDirectDrawSurface; X, Y, Width, Height: Integer; PatternIndex: Integer;
1698
    procedure DrawWaveXSub(Dest: TDirectDrawSurface; X, Y, Width, Height: Integer; PatternIndex: Integer;
793
      amp, Len, ph: Integer; Alpha: Integer{$IFDEF DelphiX_Spt4}=255{$ENDIF});
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});
794
    procedure Restore;
1717
    procedure Restore;
795
    property Height: Integer read GetHeight;
1718
    property Height: Integer read GetHeight;
796
    property Initialized: Boolean read FInitialized;
1719
    property Initialized: Boolean read FInitialized;
797
    property PictureCollection: TPictureCollection read GetPictureCollection;
1720
    property PictureCollection: TPictureCollection read GetPictureCollection;
798
    property PatternCount: Integer read GetPatternCount;
1721
    property PatternCount: Integer read GetPatternCount;
Line 821... Line 1744...
821
    procedure WriteColorTable(Stream: TStream);
1744
    procedure WriteColorTable(Stream: TStream);
822
    function Initialized: Boolean;
1745
    function Initialized: Boolean;
823
  protected
1746
  protected
824
    procedure DefineProperties(Filer: TFiler); override;
1747
    procedure DefineProperties(Filer: TFiler); override;
825
    function GetOwner: TPersistent; override;
1748
    function GetOwner: TPersistent; override;
826
  public                                    
1749
  public
827
    ColorTable: TRGBQuads;
1750
    ColorTable: TRGBQuads;
828
    constructor Create(AOwner: TPersistent);
1751
    constructor Create(AOwner: TPersistent);
829
    destructor Destroy; override;
1752
    destructor Destroy; override;
830
    function Find(const Name: string): TPictureCollectionItem;
1753
    function Find(const Name: string): TPictureCollectionItem;
831
    procedure Finalize;
1754
    procedure Finalize;
832
    procedure Initialize(DXDraw: TCustomDXDraw);
1755
    procedure Initialize(DXDraw: TCustomDXDraw);
-
 
1756
    procedure InitializeImages(DXDraw: TCustomDXDraw; Id : Integer);
833
    procedure LoadFromFile(const FileName: string);
1757
    procedure LoadFromFile(const FileName: string);
834
    procedure LoadFromStream(Stream: TStream);
1758
    procedure LoadFromStream(Stream: TStream);
835
    procedure MakeColorTable;
1759
    procedure MakeColorTable;
836
    procedure Restore;
1760
    procedure Restore;
837
    procedure SaveToFile(const FileName: string);
1761
    procedure SaveToFile(const FileName: string);
Line 889... Line 1813...
889
  public
1813
  public
890
    constructor Create(DDraw: TDirectDraw; TargetSurface: TDirectDrawSurface);
1814
    constructor Create(DDraw: TDirectDraw; TargetSurface: TDirectDrawSurface);
891
    constructor CreateWindowed(WindowHandle: HWND);
1815
    constructor CreateWindowed(WindowHandle: HWND);
892
    destructor Destroy; override;
1816
    destructor Destroy; override;
893
    procedure Finalize;
1817
    procedure Finalize;
894
    procedure Initialize(const SurfaceDesc: TDDSurfaceDesc);
1818
    procedure Initialize(const SurfaceDesc: {$IFDEF D3D_deprecated}TDDSurfaceDesc{$ELSE}TDDSurfaceDesc2{$ENDIF});
895
    procedure Flip;
1819
    procedure Flip;
896
    property OverlayColorKey: TColor read FOverlayColorKey write SetOverlayColorKey;
1820
    property OverlayColorKey: TColor read FOverlayColorKey write SetOverlayColorKey;
897
    property OverlayRect: TRect read FOverlayRect write SetOverlayRect;
1821
    property OverlayRect: TRect read FOverlayRect write SetOverlayRect;
898
    property Surface: TDirectDrawSurface read FSurface;
1822
    property Surface: TDirectDrawSurface read FSurface;
899
    property BackSurface: TDirectDrawSurface read FBackSurface;
1823
    property BackSurface: TDirectDrawSurface read FBackSurface;
900
    property Visible: Boolean read FVisible write SetVisible;
1824
    property Visible: Boolean read FVisible write SetVisible;
901
  end;
1825
  end;
902
 
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
 
903
implementation
2339
implementation
904
 
2340
 
905
uses DXConsts, DXRender;
2341
uses DXConsts{$IFDEF DXR_deprecated}, DXRender{$ENDIF}, D3DUtils;
906
                             
-
 
-
 
2342
 
907
function DXDirectDrawEnumerate(lpCallback: TDDEnumCallbackA;
2343
function DXDirectDrawEnumerate(lpCallback: {$IFDEF UNICODE}TDDEnumCallbackW{$ELSE}TDDEnumCallbackA{$ENDIF};
908
    lpContext: Pointer): HRESULT;
2344
  lpContext: Pointer): HRESULT;
909
type
2345
type
910
  TDirectDrawEnumerate = function(lpCallback: TDDEnumCallbackA;
2346
  TDirectDrawEnumerate = function(lpCallback: {$IFDEF UNICODE}TDDEnumCallbackW{$ELSE}TDDEnumCallbackA{$ENDIF};
911
    lpContext: Pointer): HRESULT; stdcall;
2347
    lpContext: Pointer): HRESULT; stdcall;
912
begin
2348
begin
913
  Result := TDirectDrawEnumerate(DXLoadLibrary('DDraw.dll', 'DirectDrawEnumerateA'))
2349
  Result := TDirectDrawEnumerate(DXLoadLibrary('DDraw.dll', {$IFDEF UNICODE}'DirectDrawEnumerateW'{$ELSE}'DirectDrawEnumerateA'{$ENDIF}))
914
    (lpCallback, lpContext);
2350
    (lpCallback, lpContext);
915
end;
2351
end;
916
 
2352
 
917
var
2353
var
918
  DirectDrawDrivers: TDirectXDrivers;
2354
  DirectDrawDrivers: TDirectXDrivers;
-
 
2355
  {$IFDEF _DMO_}DirectDrawDriversEx: TDirectXDriversEx;{$ENDIF}
-
 
2356
  D2D: TD2D = nil; {for internal use only, }
-
 
2357
  RenderError: Boolean = false;
919
 
2358
 
920
function EnumDirectDrawDrivers: TDirectXDrivers;
2359
function EnumDirectDrawDrivers: TDirectXDrivers;
921
 
2360
 
922
  function DDENUMCALLBACK(lpGuid: PGUID; lpstrDescription: LPCSTR;
2361
  function DDENUMCALLBACK(lpGuid: PGUID; lpstrDescription: {$IFDEF UNICODE}LPCTSTR{$ELSE}LPCSTR{$ENDIF};
923
    lpstrModule: LPCSTR; lpContext: Pointer): BOOL; stdcall;
2362
    lpstrModule: {$IFDEF UNICODE}LPCTSTR{$ELSE}LPCSTR{$ENDIF}; lpContext: Pointer): BOOL; stdcall;
924
  begin
2363
  begin
925
    Result := True;
2364
    Result := True;
926
    with TDirectXDriver.Create(TDirectXDrivers(lpContext)) do
2365
    with TDirectXDriver.Create(TDirectXDrivers(lpContext)) do
927
    begin
2366
    begin
928
      Guid := lpGuid;
2367
      Guid := lpGuid;
Line 930... Line 2369...
930
      DriverName := lpstrModule;
2369
      DriverName := lpstrModule;
931
    end;
2370
    end;
932
  end;
2371
  end;
933
 
2372
 
934
begin
2373
begin
935
  if DirectDrawDrivers=nil then
2374
  if DirectDrawDrivers = nil then
936
  begin
2375
  begin
937
    DirectDrawDrivers := TDirectXDrivers.Create;
2376
    DirectDrawDrivers := TDirectXDrivers.Create;
938
    try                    
2377
    try
939
      DXDirectDrawEnumerate(@DDENUMCALLBACK, DirectDrawDrivers);
2378
      DXDirectDrawEnumerate(@DDENUMCALLBACK, DirectDrawDrivers);
940
    except
2379
    except
941
      DirectDrawDrivers.Free;
2380
      DirectDrawDrivers.Free;
942
      raise;
2381
      raise;
943
    end;
2382
    end;
944
  end;
2383
  end;
945
 
2384
 
946
  Result := DirectDrawDrivers;
2385
  Result := DirectDrawDrivers;
947
end;
2386
end;
948
 
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
 
949
function ClipRect(var DestRect: TRect; const DestRect2: TRect): Boolean;
2427
function ClipRect(var DestRect: TRect; const DestRect2: TRect): Boolean;
950
begin
2428
begin
951
  with DestRect do
2429
  with DestRect do
952
  begin
2430
  begin
953
    Left := Max(Left, DestRect2.Left);
2431
    Left := Max(Left, DestRect2.Left);
Line 1031... Line 2509...
1031
  inherited Create;
2509
  inherited Create;
1032
  FClippers := TList.Create;
2510
  FClippers := TList.Create;
1033
  FPalettes := TList.Create;
2511
  FPalettes := TList.Create;
1034
  FSurfaces := TList.Create;
2512
  FSurfaces := TList.Create;
1035
 
2513
 
-
 
2514
  {$IFDEF D3D_deprecated}
1036
  if DirectX7Mode then
2515
  if DirectX7Mode then
1037
  begin
2516
  begin {$ENDIF}
1038
    { DirectX 7 }
2517
    { DirectX 7 }
1039
    if TDirectDrawCreateEx(DXLoadLibrary('DDraw.dll', 'DirectDrawCreateEx')) (GUID, FIDDraw7, IID_IDirectDraw7, nil)<>DD_OK then
2518
    if TDirectDrawCreateEx(DXLoadLibrary('DDraw.dll', 'DirectDrawCreateEx'))(GUID, FIDDraw7, IID_IDirectDraw7, nil) <> DD_OK then
1040
      raise EDirectDrawError.CreateFmt(SCannotInitialized, [SDirectDraw]);
2519
      raise EDirectDrawError.CreateFmt(SCannotInitialized, [SDirectDraw]);
-
 
2520
    {$IFDEF D3D_deprecated}
1041
    try
2521
    try
1042
      FIDDraw := FIDDraw7 as IDirectDraw;
2522
      FIDDraw := FIDDraw7 as IDirectDraw;
1043
      FIDDraw4 := FIDDraw7 as IDirectDraw4;
2523
      FIDDraw4 := FIDDraw7 as IDirectDraw4;
1044
    except
2524
    except
1045
      raise EDirectDrawError.Create(SSinceDirectX7);
2525
      raise EDirectDrawError.Create(SSinceDirectX7);
1046
    end;
2526
    end;
1047
  end else
2527
    {$ENDIF}
-
 
2528
  {$IFDEF D3D_deprecated}end else
1048
  begin
2529
  begin
1049
    if TDirectDrawCreate(DXLoadLibrary('DDraw.dll', 'DirectDrawCreate')) (GUID, FIDDraw, nil)<>DD_OK then
2530
    if TDirectDrawCreate(DXLoadLibrary('DDraw.dll', 'DirectDrawCreate'))(GUID, FIDDraw, nil) <> DD_OK then
1050
      raise EDirectDrawError.CreateFmt(SCannotInitialized, [SDirectDraw]);
2531
      raise EDirectDrawError.CreateFmt(SCannotInitialized, [SDirectDraw]);
1051
    try
2532
    try
1052
      FIDDraw4 := FIDDraw as IDirectDraw4;
2533
      FIDDraw4 := FIDDraw as IDirectDraw4;
1053
    except
2534
    except
1054
      raise EDirectDrawError.Create(SSinceDirectX6);
2535
      raise EDirectDrawError.Create(SSinceDirectX6);
1055
    end;
2536
    end;
1056
  end;
2537
  end;{$ENDIF}
1057
 
2538
 
1058
  FDriverCaps.dwSize := SizeOf(FDriverCaps);
2539
  FDriverCaps.dwSize := SizeOf(FDriverCaps);
1059
  FHELCaps.dwSize := SizeOf(FHELCaps);
2540
  FHELCaps.dwSize := SizeOf(FHELCaps);
1060
  FIDDraw.GetCaps(FDriverCaps, FHELCaps);
2541
  {$IFDEF D3D_deprecated}FIDDraw{$ELSE}FIDDraw7{$ENDIF}.GetCaps(@FDriverCaps, @FHELCaps);
1061
end;
2542
end;
1062
 
2543
 
1063
destructor TDirectDraw.Destroy;
2544
destructor TDirectDraw.Destroy;
1064
begin
2545
begin
1065
  while SurfaceCount>0 do
2546
  while SurfaceCount > 0 do
1066
    Surfaces[SurfaceCount-1].Free;
2547
    Surfaces[SurfaceCount - 1].Free;
1067
 
2548
 
1068
  while PaletteCount>0 do
2549
  while PaletteCount > 0 do
1069
    Palettes[PaletteCount-1].Free;
2550
    Palettes[PaletteCount - 1].Free;
1070
 
2551
 
1071
  while ClipperCount>0 do
2552
  while ClipperCount > 0 do
1072
    Clippers[ClipperCount-1].Free;
2553
    Clippers[ClipperCount - 1].Free;
1073
 
2554
 
1074
  FSurfaces.Free;
2555
  FSurfaces.Free;
1075
  FPalettes.Free;
2556
  FPalettes.Free;
1076
  FClippers.Free;
2557
  FClippers.Free;
1077
  inherited Destroy;
2558
  inherited Destroy;
Line 1080... Line 2561...
1080
class function TDirectDraw.Drivers: TDirectXDrivers;
2561
class function TDirectDraw.Drivers: TDirectXDrivers;
1081
begin
2562
begin
1082
  Result := EnumDirectDrawDrivers;
2563
  Result := EnumDirectDrawDrivers;
1083
end;
2564
end;
1084
 
2565
 
-
 
2566
{$IFDEF _DMO_}
-
 
2567
class function TDirectDraw.DriversEx: TDirectXDriversEx;
-
 
2568
begin
-
 
2569
  Result := EnumDirectDrawDriversEx;
-
 
2570
end;
-
 
2571
{$ENDIF}
-
 
2572
 
1085
function TDirectDraw.GetClipper(Index: Integer): TDirectDrawClipper;
2573
function TDirectDraw.GetClipper(Index: Integer): TDirectDrawClipper;
1086
begin
2574
begin
1087
  Result := FClippers[Index];
2575
  Result := FClippers[Index];
1088
end;
2576
end;
1089
 
2577
 
1090
function TDirectDraw.GetClipperCount: Integer;
2578
function TDirectDraw.GetClipperCount: Integer;
1091
begin
2579
begin
1092
  Result := FClippers.Count;
2580
  Result := FClippers.Count;
1093
end;
2581
end;
1094
 
2582
 
1095
function TDirectDraw.GetDisplayMode: TDDSurfaceDesc;
2583
function TDirectDraw.GetDisplayMode: {$IFDEF D3D_deprecated}TDDSurfaceDesc{$ELSE}TDDSurfaceDesc2{$ENDIF};
1096
begin
2584
begin
1097
  Result.dwSize := SizeOf(Result);
2585
  Result.dwSize := SizeOf(Result);
1098
  DXResult := IDraw.GetDisplayMode(Result);
2586
  DXResult := {$IFDEF D3D_deprecated}IDraw{$ELSE}IDraw7{$ENDIF}.GetDisplayMode(Result);
1099
  if DXResult<>DD_OK then
2587
  if DXResult <> DD_OK then
1100
    FillChar(Result, SizeOf(Result), 0);
2588
    FillChar(Result, SizeOf(Result), 0);
1101
end;
2589
end;
1102
 
-
 
-
 
2590
{$IFDEF D3D_deprecated}
1103
function TDirectDraw.GetIDDraw: IDirectDraw;
2591
function TDirectDraw.GetIDDraw: IDirectDraw;
1104
begin
2592
begin
1105
  if Self<>nil then
2593
  if Self <> nil then
1106
    Result := FIDDraw
2594
    Result := FIDDraw
1107
  else
2595
  else
1108
    Result := nil;
2596
    Result := nil;
1109
end;
2597
end;
1110
 
2598
 
1111
function TDirectDraw.GetIDDraw4: IDirectDraw4;
2599
function TDirectDraw.GetIDDraw4: IDirectDraw4;
1112
begin
2600
begin
1113
  if Self<>nil then
2601
  if Self <> nil then
1114
    Result := FIDDraw4
2602
    Result := FIDDraw4
1115
  else
2603
  else
1116
    Result := nil;
2604
    Result := nil;
1117
end;
2605
end;
1118
 
2606
{$ENDIF}
1119
function TDirectDraw.GetIDDraw7: IDirectDraw7;
2607
function TDirectDraw.GetIDDraw7: IDirectDraw7;
1120
begin
2608
begin
1121
  if Self<>nil then
2609
  if Self <> nil then
1122
    Result := FIDDraw7
2610
    Result := FIDDraw7
1123
  else
2611
  else
1124
    Result := nil;
2612
    Result := nil;
1125
end;
2613
end;
1126
 
-
 
-
 
2614
{$IFDEF D3D_deprecated}
1127
function TDirectDraw.GetIDraw: IDirectDraw;
2615
function TDirectDraw.GetIDraw: IDirectDraw;
1128
begin
2616
begin
1129
  Result := IDDraw;
2617
  Result := IDDraw;
1130
  if Result=nil then
2618
  if Result = nil then
1131
    raise EDirectDrawError.CreateFmt(SNotMade, ['IDirectDraw']);
2619
    raise EDirectDrawError.CreateFmt(SNotMade, ['IDirectDraw']);
1132
end;
2620
end;
1133
 
2621
 
1134
function TDirectDraw.GetIDraw4: IDirectDraw4;
2622
function TDirectDraw.GetIDraw4: IDirectDraw4;
1135
begin
2623
begin
1136
  Result := IDDraw4;
2624
  Result := IDDraw4;
1137
  if Result=nil then
2625
  if Result = nil then
1138
    raise EDirectDrawError.CreateFmt(SNotMade, ['IDirectDraw4']);
2626
    raise EDirectDrawError.CreateFmt(SNotMade, ['IDirectDraw4']);
1139
end;
2627
end;
1140
 
2628
{$ENDIF}
1141
function TDirectDraw.GetIDraw7: IDirectDraw7;
2629
function TDirectDraw.GetIDraw7: IDirectDraw7;
1142
begin
2630
begin
1143
  Result := IDDraw7;
2631
  Result := IDDraw7;
1144
  if Result=nil then
2632
  if Result = nil then
1145
    raise EDirectDrawError.CreateFmt(SNotMade, ['IDirectDraw7']);
2633
    raise EDirectDrawError.CreateFmt(SNotMade, ['IDirectDraw7']);
1146
end;
2634
end;
1147
 
2635
 
1148
function TDirectDraw.GetPalette(Index: Integer): TDirectDrawPalette;
2636
function TDirectDraw.GetPalette(Index: Integer): TDirectDrawPalette;
1149
begin
2637
begin
Line 1184... Line 2672...
1184
var
2672
var
1185
  TempPalette: IDirectDrawPalette;
2673
  TempPalette: IDirectDrawPalette;
1186
begin
2674
begin
1187
  IDDPalette := nil;
2675
  IDDPalette := nil;
1188
 
2676
 
1189
  FDDraw.DXResult := FDDraw.IDraw.CreatePalette(Caps, @Entries, TempPalette, nil);
2677
  FDDraw.DXResult := FDDraw.{$IFDEF D3D_deprecated}IDraw{$ELSE}IDraw7{$ENDIF}.CreatePalette(Caps, @Entries, TempPalette, nil);
1190
  FDXResult := FDDraw.DXResult;
2678
  FDXResult := FDDraw.DXResult;
1191
  Result := FDDraw.DXResult=DD_OK;
2679
  Result := FDDraw.DXResult = DD_OK;
1192
  if Result then
2680
  if Result then
1193
    IDDPalette := TempPalette;
2681
    IDDPalette := TempPalette;
1194
end;
2682
end;
1195
 
2683
 
1196
procedure TDirectDrawPalette.LoadFromDIB(DIB: TDIB);
2684
procedure TDirectDrawPalette.LoadFromDIB(DIB: TDIB);
Line 1218... Line 2706...
1218
  DIB: TDIB;
2706
  DIB: TDIB;
1219
begin
2707
begin
1220
  DIB := TDIB.Create;
2708
  DIB := TDIB.Create;
1221
  try
2709
  try
1222
    DIB.LoadFromStream(Stream);
2710
    DIB.LoadFromStream(Stream);
1223
    if DIB.Size>0 then
2711
    if DIB.Size > 0 then
1224
      LoadFromDIB(DIB);
2712
      LoadFromDIB(DIB);
1225
  finally
2713
  finally
1226
    DIB.Free;
2714
    DIB.Free;
1227
  end;
2715
  end;
1228
end;
2716
end;
1229
 
2717
 
1230
function TDirectDrawPalette.GetEntries(StartIndex, NumEntries: Integer;
2718
function TDirectDrawPalette.GetEntries(StartIndex, NumEntries: Integer;
1231
  var Entries): Boolean;
2719
  var Entries): Boolean;
1232
begin
2720
begin
1233
  if IDDPalette<>nil then
2721
  if IDDPalette <> nil then
1234
  begin
2722
  begin
1235
    DXResult := IPalette.GetEntries(0, StartIndex, NumEntries, @Entries);
2723
    DXResult := IPalette.GetEntries(0, StartIndex, NumEntries, @Entries);
1236
    Result := DXResult=DD_OK;
2724
    Result := DXResult = DD_OK;
1237
  end else
2725
  end else
1238
    Result := False;
2726
    Result := False;
1239
end;
2727
end;
1240
 
2728
 
1241
function TDirectDrawPalette.GetEntry(Index: Integer): TPaletteEntry;
2729
function TDirectDrawPalette.GetEntry(Index: Integer): TPaletteEntry;
Line 1243... Line 2731...
1243
  GetEntries(Index, 1, Result);
2731
  GetEntries(Index, 1, Result);
1244
end;
2732
end;
1245
 
2733
 
1246
function TDirectDrawPalette.GetIDDPalette: IDirectDrawPalette;
2734
function TDirectDrawPalette.GetIDDPalette: IDirectDrawPalette;
1247
begin
2735
begin
1248
  if Self<>nil then
2736
  if Self <> nil then
1249
    Result := FIDDPalette
2737
    Result := FIDDPalette
1250
  else
2738
  else
1251
    Result := nil;
2739
    Result := nil;
1252
end;
2740
end;
1253
 
2741
 
1254
function TDirectDrawPalette.GetIPalette: IDirectDrawPalette;
2742
function TDirectDrawPalette.GetIPalette: IDirectDrawPalette;
1255
begin
2743
begin
1256
  Result := IDDPalette;
2744
  Result := IDDPalette;
1257
  if Result=nil then
2745
  if Result = nil then
1258
    raise EDirectDrawPaletteError.CreateFmt(SNotMade, ['IDirectDrawPalette']);
2746
    raise EDirectDrawPaletteError.CreateFmt(SNotMade, ['IDirectDrawPalette']);
1259
end;
2747
end;
1260
 
2748
 
1261
function TDirectDrawPalette.SetEntries(StartIndex, NumEntries: Integer;
2749
function TDirectDrawPalette.SetEntries(StartIndex, NumEntries: Integer;
1262
  const Entries): Boolean;
2750
  const Entries): Boolean;
1263
begin
2751
begin
1264
  if IDDPalette<>nil then
2752
  if IDDPalette <> nil then
1265
  begin
2753
  begin
1266
    DXResult := IPalette.SetEntries(0, StartIndex, NumEntries, @Entries);
2754
    DXResult := IPalette.SetEntries(0, StartIndex, NumEntries, @Entries);
1267
    Result := DXResult=DD_OK;
2755
    Result := DXResult = DD_OK;
1268
  end else
2756
  end else
1269
    Result := False;
2757
    Result := False;
1270
end;
2758
end;
1271
 
2759
 
1272
procedure TDirectDrawPalette.SetEntry(Index: Integer; Value: TPaletteEntry);
2760
procedure TDirectDrawPalette.SetEntry(Index: Integer; Value: TPaletteEntry);
Line 1274... Line 2762...
1274
  SetEntries(Index, 1, Value);
2762
  SetEntries(Index, 1, Value);
1275
end;
2763
end;
1276
 
2764
 
1277
procedure TDirectDrawPalette.SetIDDPalette(Value: IDirectDrawPalette);
2765
procedure TDirectDrawPalette.SetIDDPalette(Value: IDirectDrawPalette);
1278
begin
2766
begin
1279
  if FIDDPalette=Value then Exit;
2767
  if FIDDPalette = Value then Exit;
1280
  FIDDPalette := Value;
2768
  FIDDPalette := Value;
1281
end;
2769
end;
1282
 
2770
 
1283
{  TDirectDrawClipper  }
2771
{  TDirectDrawClipper  }
1284
 
2772
 
Line 1286... Line 2774...
1286
begin
2774
begin
1287
  inherited Create;
2775
  inherited Create;
1288
  FDDraw := ADirectDraw;
2776
  FDDraw := ADirectDraw;
1289
  FDDraw.FClippers.Add(Self);
2777
  FDDraw.FClippers.Add(Self);
1290
 
2778
 
1291
  FDDraw.DXResult := FDDraw.IDraw.CreateClipper(0, FIDDClipper, nil);
2779
  FDDraw.DXResult := FDDraw.{$IFDEF D3D_deprecated}IDraw{$ELSE}IDraw7{$ENDIF}.CreateClipper(0, FIDDClipper, nil);
1292
  if FDDraw.DXResult<>DD_OK then
2780
  if FDDraw.DXResult <> DD_OK then
1293
    raise EDirectDrawClipperError.CreateFmt(SCannotMade, [SDirectDrawClipper]);
2781
    raise EDirectDrawClipperError.CreateFmt(SCannotMade, [SDirectDrawClipper]);
1294
end;
2782
end;
1295
 
2783
 
1296
destructor TDirectDrawClipper.Destroy;
2784
destructor TDirectDrawClipper.Destroy;
1297
begin
2785
begin
Line 1299... Line 2787...
1299
  inherited Destroy;
2787
  inherited Destroy;
1300
end;
2788
end;
1301
 
2789
 
1302
function TDirectDrawClipper.GetIDDClipper: IDirectDrawClipper;
2790
function TDirectDrawClipper.GetIDDClipper: IDirectDrawClipper;
1303
begin
2791
begin
1304
  if Self<>nil then
2792
  if Self <> nil then
1305
    Result := FIDDClipper
2793
    Result := FIDDClipper
1306
  else
2794
  else
1307
    Result := nil;
2795
    Result := nil;
1308
end;
2796
end;
1309
 
2797
 
1310
function TDirectDrawClipper.GetIClipper: IDirectDrawClipper;
2798
function TDirectDrawClipper.GetIClipper: IDirectDrawClipper;
1311
begin
2799
begin
1312
  Result := IDDClipper;
2800
  Result := IDDClipper;
1313
  if Result=nil then
2801
  if Result = nil then
1314
    raise EDirectDrawClipperError.CreateFmt(SNotMade, ['IDirectDrawClipper']);
2802
    raise EDirectDrawClipperError.CreateFmt(SNotMade, ['IDirectDrawClipper']);
1315
end;
2803
end;
1316
 
2804
 
1317
procedure TDirectDrawClipper.SetClipRects(const Rects: array of TRect);
2805
procedure TDirectDrawClipper.SetClipRects(const Rects: array of TRect);
1318
type
2806
type
Line 1322... Line 2810...
1322
  RgnData: PRgnData;
2810
  RgnData: PRgnData;
1323
  i: Integer;
2811
  i: Integer;
1324
  BoundsRect: TRect;
2812
  BoundsRect: TRect;
1325
begin
2813
begin
1326
  BoundsRect := Rect(MaxInt, MaxInt, -MaxInt, -MaxInt);
2814
  BoundsRect := Rect(MaxInt, MaxInt, -MaxInt, -MaxInt);
1327
  for i:=Low(Rects) to High(Rects) do
2815
  for i := Low(Rects) to High(Rects) do
1328
  begin
2816
  begin
1329
    with BoundsRect do
2817
    with BoundsRect do
1330
    begin
2818
    begin
1331
      Left := Min(Rects[i].Left, Left);
2819
      Left := Min(Rects[i].Left, Left);
1332
      Right := Max(Rects[i].Right, Right);
2820
      Right := Max(Rects[i].Right, Right);
1333
      Top := Min(Rects[i].Top, Top);
2821
      Top := Min(Rects[i].Top, Top);
1334
      Bottom := Max(Rects[i].Bottom, Bottom);
2822
      Bottom := Max(Rects[i].Bottom, Bottom);
1335
    end;                          
2823
    end;
1336
  end;
2824
  end;
1337
 
2825
 
1338
  GetMem(RgnData, SizeOf(TRgnDataHeader)+SizeOf(TRect)*(High(Rects)-Low(Rects)+1));
2826
  GetMem(RgnData, SizeOf(TRgnDataHeader) + SizeOf(TRect) * (High(Rects) - Low(Rects) + 1));
1339
  try
2827
  try
1340
    with RgnData^.rdh do
2828
    with RgnData^.rdh do
1341
    begin
2829
    begin
1342
      dwSize := SizeOf(TRgnDataHeader);
2830
      dwSize := SizeOf(TRgnDataHeader);
1343
      iType := RDH_RECTANGLES;
2831
      iType := RDH_RECTANGLES;
1344
      nCount := High(Rects)-Low(Rects)+1;
2832
      nCount := High(Rects) - Low(Rects) + 1;
1345
      nRgnSize := nCount*SizeOf(TRect);
2833
      nRgnSize := nCount * SizeOf(TRect);
1346
      rcBound := BoundsRect;
2834
      rcBound := BoundsRect;
1347
    end;
2835
    end;
1348
    for i:=Low(Rects) to High(Rects) do
2836
    for i := Low(Rects) to High(Rects) do
1349
      PArrayRect(@RgnData^.Buffer)^[i-Low(Rects)] := Rects[i];
2837
      PArrayRect(@RgnData^.Buffer)^[i - Low(Rects)] := Rects[i];
1350
    DXResult := IClipper.SetClipList(RgnData, 0);
2838
    DXResult := IClipper.SetClipList(RgnData, 0);
1351
  finally
2839
  finally
1352
    FreeMem(RgnData);
2840
    FreeMem(RgnData);
1353
  end;
2841
  end;
1354
end;
2842
end;
Line 1358... Line 2846...
1358
  DXResult := IClipper.SetHWnd(0, Value);
2846
  DXResult := IClipper.SetHWnd(0, Value);
1359
end;
2847
end;
1360
 
2848
 
1361
procedure TDirectDrawClipper.SetIDDClipper(Value: IDirectDrawClipper);
2849
procedure TDirectDrawClipper.SetIDDClipper(Value: IDirectDrawClipper);
1362
begin
2850
begin
1363
  if FIDDClipper=Value then Exit;
2851
  if FIDDClipper = Value then Exit;
1364
  FIDDClipper := Value;
2852
  FIDDClipper := Value;
1365
end;
2853
end;
1366
 
2854
 
1367
{  TDirectDrawSurfaceCanvas  }
2855
{  TDirectDrawSurfaceCanvas  }
1368
 
2856
 
Line 1379... Line 2867...
1379
  inherited Destroy;
2867
  inherited Destroy;
1380
end;
2868
end;
1381
 
2869
 
1382
procedure TDirectDrawSurfaceCanvas.CreateHandle;
2870
procedure TDirectDrawSurfaceCanvas.CreateHandle;
1383
begin
2871
begin
1384
  FSurface.DXResult := FSurface.ISurface.GetDC(FDC);
2872
  FSurface.DXResult := FSurface.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}.GetDC(FDC);
1385
  if FSurface.DXResult=DD_OK then
2873
  if FSurface.DXResult = DD_OK then
1386
    Handle := FDC;
2874
    Handle := FDC;
1387
end;
2875
end;
1388
 
2876
 
1389
procedure TDirectDrawSurfaceCanvas.Release;
2877
procedure TDirectDrawSurfaceCanvas.Release;
1390
begin
2878
begin
1391
  if (FSurface.IDDSurface<>nil) and (FDC<>0) then
2879
  if (FSurface.{$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF} <> nil) and (FDC <> 0) then
1392
  begin
2880
  begin
1393
    Handle := 0;
2881
    Handle := 0;
1394
    FSurface.IDDSurface.ReleaseDC(FDC);
2882
    FSurface.{$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF}.ReleaseDC(FDC);
1395
    FDC := 0;
2883
    FDC := 0;
1396
  end;
2884
  end;
1397
end;
2885
end;
1398
 
2886
 
1399
{  TDirectDrawSurface  }
2887
{  TDirectDrawSurface  }
Line 1401... Line 2889...
1401
constructor TDirectDrawSurface.Create(ADirectDraw: TDirectDraw);
2889
constructor TDirectDrawSurface.Create(ADirectDraw: TDirectDraw);
1402
begin
2890
begin
1403
  inherited Create;
2891
  inherited Create;
1404
  FDDraw := ADirectDraw;
2892
  FDDraw := ADirectDraw;
1405
  FDDraw.FSurfaces.Add(Self);
2893
  FDDraw.FSurfaces.Add(Self);
-
 
2894
  DIB_COLMATCH := TDIB.Create;
1406
end;
2895
end;
1407
 
2896
 
1408
destructor TDirectDrawSurface.Destroy;
2897
destructor TDirectDrawSurface.Destroy;
1409
begin
2898
begin
-
 
2899
  DIB_COLMATCH.Free;
1410
  FCanvas.Free;
2900
  FCanvas.Free;
1411
  IDDSurface := nil;
2901
  {$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF} := nil;
1412
  FDDraw.FSurfaces.Remove(Self);
2902
  FDDraw.FSurfaces.Remove(Self);
1413
  inherited Destroy;
2903
  inherited Destroy;
1414
end;
2904
end;
1415
 
-
 
-
 
2905
{$IFDEF D3D_deprecated}
1416
function TDirectDrawSurface.GetIDDSurface: IDirectDrawSurface;
2906
function TDirectDrawSurface.GetIDDSurface: IDirectDrawSurface;
1417
begin
2907
begin
1418
  if Self<>nil then
2908
  if Self <> nil then
1419
    Result := FIDDSurface
2909
    Result := FIDDSurface
1420
  else
2910
  else
1421
    Result := nil;
2911
    Result := nil;
1422
end;
2912
end;
1423
 
2913
 
1424
function TDirectDrawSurface.GetIDDSurface4: IDirectDrawSurface4;
2914
function TDirectDrawSurface.GetIDDSurface4: IDirectDrawSurface4;
1425
begin
2915
begin
1426
  if Self<>nil then
2916
  if Self <> nil then
1427
    Result := FIDDSurface4
2917
    Result := FIDDSurface4
1428
  else
2918
  else
1429
    Result := nil;
2919
    Result := nil;
1430
end;
2920
end;
1431
 
2921
{$ENDIF}
1432
function TDirectDrawSurface.GetIDDSurface7: IDirectDrawSurface7;
2922
function TDirectDrawSurface.GetIDDSurface7: IDirectDrawSurface7;
1433
begin
2923
begin
1434
  if Self<>nil then
2924
  if Self <> nil then
1435
    Result := FIDDSurface7
2925
    Result := FIDDSurface7
1436
  else
2926
  else
1437
    Result := nil;
2927
    Result := nil;
1438
end;
2928
end;
1439
 
-
 
-
 
2929
{$IFDEF D3D_deprecated}
1440
function TDirectDrawSurface.GetISurface: IDirectDrawSurface;
2930
function TDirectDrawSurface.GetISurface: IDirectDrawSurface;
1441
begin
2931
begin
1442
  Result := IDDSurface;
2932
  Result := IDDSurface;
1443
  if Result=nil then
2933
  if Result = nil then
1444
    raise EDirectDrawSurfaceError.CreateFmt(SNotMade, ['IDirectDrawSurface']);
2934
    raise EDirectDrawSurfaceError.CreateFmt(SNotMade, ['IDirectDrawSurface']);
1445
end;
2935
end;
1446
 
2936
 
1447
function TDirectDrawSurface.GetISurface4: IDirectDrawSurface4;
2937
function TDirectDrawSurface.GetISurface4: IDirectDrawSurface4;
1448
begin
2938
begin
1449
  Result := IDDSurface4;
2939
  Result := IDDSurface4;
1450
  if Result=nil then
2940
  if Result = nil then
1451
    raise EDirectDrawSurfaceError.CreateFmt(SNotMade, ['IDirectDrawSurface4']);
2941
    raise EDirectDrawSurfaceError.CreateFmt(SNotMade, ['IDirectDrawSurface4']);
1452
end;
2942
end;
1453
 
2943
{$ENDIF}
1454
function TDirectDrawSurface.GetISurface7: IDirectDrawSurface7;
2944
function TDirectDrawSurface.GetISurface7: IDirectDrawSurface7;
1455
begin
2945
begin
1456
  Result := IDDSurface7;
2946
  Result := IDDSurface7;
1457
  if Result=nil then
2947
  if Result = nil then
1458
    raise EDirectDrawSurfaceError.CreateFmt(SNotMade, ['IDirectDrawSurface7']);
2948
    raise EDirectDrawSurfaceError.CreateFmt(SNotMade, ['IDirectDrawSurface7']);
1459
end;
2949
end;
1460
 
-
 
-
 
2950
{$IFDEF D3D_deprecated}
1461
procedure TDirectDrawSurface.SetIDDSurface(Value: IDirectDrawSurface);
2951
procedure TDirectDrawSurface.SetIDDSurface(Value: IDirectDrawSurface);
1462
var
2952
var
1463
  Clipper: IDirectDrawClipper;
2953
  Clipper: IDirectDrawClipper;
1464
begin
2954
begin
1465
  if Value=nil then Exit;
2955
  if Value = nil then Exit;
1466
  if Value as IDirectDrawSurface=FIDDSurface then Exit;
2956
  if Value as IDirectDrawSurface = FIDDSurface then Exit;
1467
 
2957
 
1468
  FIDDSurface := nil;
2958
  FIDDSurface := nil;
1469
  FIDDSurface4 := nil;
2959
  FIDDSurface4 := nil;
1470
  FIDDSurface7 := nil;
2960
  FIDDSurface7 := nil;
1471
 
2961
 
Line 1473... Line 2963...
1473
  FGammaControl := nil;
2963
  FGammaControl := nil;
1474
  FHasClipper := False;
2964
  FHasClipper := False;
1475
  FLockCount := 0;
2965
  FLockCount := 0;
1476
  FillChar(FSurfaceDesc, SizeOf(FSurfaceDesc), 0);
2966
  FillChar(FSurfaceDesc, SizeOf(FSurfaceDesc), 0);
1477
 
2967
 
1478
  if Value<>nil then
2968
  if Value <> nil then
1479
  begin
2969
  begin
1480
    FIDDSurface := Value as IDirectDrawSurface;
2970
    FIDDSurface := Value as IDirectDrawSurface;
1481
    FIDDSurface4 := Value as IDirectDrawSurface4;
2971
    FIDDSurface4 := Value as IDirectDrawSurface4;
1482
    if FDDraw.FIDDraw7<>nil then FIDDSurface7 := Value as IDirectDrawSurface7;
2972
    if FDDraw.FIDDraw7 <> nil then FIDDSurface7 := Value as IDirectDrawSurface7;
1483
 
2973
 
1484
    FHasClipper := (FIDDSurface.GetClipper(Clipper)=DD_OK) and (Clipper<>nil);
2974
    FHasClipper := (FIDDSurface.GetClipper(Clipper) = DD_OK) and (Clipper <> nil);
1485
 
2975
 
1486
    FSurfaceDesc.dwSize := SizeOf(FSurfaceDesc);
2976
    FSurfaceDesc.dwSize := SizeOf(FSurfaceDesc);
1487
    FIDDSurface.GetSurfaceDesc(FSurfaceDesc);
2977
    FIDDSurface.GetSurfaceDesc(FSurfaceDesc);
1488
 
2978
 
1489
    if FDDraw.DriverCaps.dwCaps2 and DDCAPS2_PRIMARYGAMMA<>0 then
2979
    if FDDraw.DriverCaps.dwCaps2 and DDCAPS2_PRIMARYGAMMA <> 0 then
1490
      FIDDSurface.QueryInterface(IID_IDirectDrawGammaControl, FGammaControl);
2980
      FIDDSurface.QueryInterface(IID_IDirectDrawGammaControl, FGammaControl);
1491
  end;
2981
  end;
1492
end;
2982
end;
1493
 
2983
 
1494
procedure TDirectDrawSurface.SetIDDSurface4(Value: IDirectDrawSurface4);
2984
procedure TDirectDrawSurface.SetIDDSurface4(Value: IDirectDrawSurface4);
1495
begin
2985
begin
1496
  if Value=nil then
2986
  if Value = nil then
1497
    SetIDDSurface(nil)
2987
    SetIDDSurface(nil)
1498
  else
2988
  else
1499
    SetIDDSurface(Value as IDirectDrawSurface);
2989
    SetIDDSurface(Value as IDirectDrawSurface);
1500
end;
2990
end;
1501
 
2991
{$ENDIF}
1502
procedure TDirectDrawSurface.SetIDDSurface7(Value: IDirectDrawSurface7);
2992
procedure TDirectDrawSurface.SetIDDSurface7(Value: IDirectDrawSurface7);
-
 
2993
{$IFNDEF D3D_deprecated}
-
 
2994
var
-
 
2995
  Clipper: IDirectDrawClipper;
-
 
2996
{$ENDIF}
1503
begin
2997
begin
-
 
2998
  {$IFDEF D3D_deprecated}
1504
  if Value=nil then
2999
  if Value = nil then
1505
    SetIDDSurface(nil)
3000
    SetIDDSurface(nil)
1506
  else
3001
  else
1507
    SetIDDSurface(Value as IDirectDrawSurface);
3002
    SetIDDSurface(Value as IDirectDrawSurface);
-
 
3003
  {$ELSE}
-
 
3004
  if Value = nil then Exit;
-
 
3005
  if Value as IDirectDrawSurface7 = FIDDSurface7 then Exit;
-
 
3006
  FIDDSurface7 := nil;
-
 
3007
 
-
 
3008
  FStretchDrawClipper := nil;
-
 
3009
  FGammaControl := nil;
-
 
3010
  FHasClipper := False;
-
 
3011
  FLockCount := 0;
-
 
3012
  FillChar(FSurfaceDesc, SizeOf(FSurfaceDesc), 0);
-
 
3013
 
-
 
3014
  if Value <> nil then
-
 
3015
  begin
-
 
3016
    if FDDraw.FIDDraw7 <> nil then FIDDSurface7 := Value as IDirectDrawSurface7;
-
 
3017
 
-
 
3018
    FHasClipper := (FIDDSurface7.GetClipper(Clipper) = DD_OK) and (Clipper <> nil);
-
 
3019
 
-
 
3020
    FSurfaceDesc.dwSize := SizeOf(FSurfaceDesc);
-
 
3021
    {$IFDEF D3D_deprecated}FIDDSurface{$ELSE}FIDDSurface7{$ENDIF}.GetSurfaceDesc(FSurfaceDesc);
-
 
3022
 
-
 
3023
    if FDDraw.DriverCaps.dwCaps2 and DDCAPS2_PRIMARYGAMMA <> 0 then
-
 
3024
      {$IFDEF D3D_deprecated}FIDDSurface{$ELSE}FIDDSurface7{$ENDIF}.QueryInterface(IID_IDirectDrawGammaControl, FGammaControl);
-
 
3025
  end;
-
 
3026
  {$ENDIF}
1508
end;
3027
end;
1509
 
3028
 
1510
procedure TDirectDrawSurface.Assign(Source: TPersistent);
3029
procedure TDirectDrawSurface.Assign(Source: TPersistent);
1511
var
3030
var
1512
  TempSurface: IDirectDrawSurface;
3031
  TempSurface: {$IFDEF D3D_deprecated}IDirectDrawSurface{$ELSE}IDirectDrawSurface7{$ENDIF};
1513
begin
3032
begin
1514
  if Source=nil then
3033
  if Source = nil then
1515
    IDDSurface := nil
3034
    {$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF} := nil
1516
  else if Source is TGraphic then
3035
  else if Source is TGraphic then
1517
    LoadFromGraphic(TGraphic(Source))
3036
    LoadFromGraphic(TGraphic(Source))
1518
  else if Source is TPicture then
3037
  else if Source is TPicture then
1519
    LoadFromGraphic(TPicture(Source).Graphic)
3038
    LoadFromGraphic(TPicture(Source).Graphic)
1520
  else if Source is TDirectDrawSurface then
3039
  else if Source is TDirectDrawSurface then
1521
  begin
3040
  begin
1522
    if TDirectDrawSurface(Source).IDDSurface=nil then
3041
    if TDirectDrawSurface(Source).{$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF} = nil then
1523
      IDDSurface := nil
3042
      {$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF} := nil
1524
    else begin
3043
    else begin
1525
      FDDraw.DXResult := FDDraw.IDraw.DuplicateSurface(TDirectDrawSurface(Source).IDDSurface,
3044
      FDDraw.DXResult := FDDraw.{$IFDEF D3D_deprecated}IDraw{$ELSE}IDraw7{$ENDIF}.DuplicateSurface(TDirectDrawSurface(Source).{$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF},
1526
        TempSurface);
3045
        TempSurface);
1527
      if FDDraw.DXResult=0 then
3046
      if FDDraw.DXResult = 0 then
1528
      begin
3047
      begin
1529
        IDDSurface := TempSurface;
3048
        {$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF} := TempSurface;
1530
      end;
3049
      end;
1531
    end;
3050
    end;
1532
  end else
3051
  end else
1533
    inherited Assign(Source);
3052
    inherited Assign(Source);
1534
end;
3053
end;
1535
 
3054
 
1536
procedure TDirectDrawSurface.AssignTo(Dest: TPersistent);
3055
procedure TDirectDrawSurface.AssignTo(Dest: TPersistent);
1537
begin
3056
begin
-
 
3057
  if Dest is TBitmap then
-
 
3058
  begin
-
 
3059
    try
-
 
3060
      TBitmap(Dest).PixelFormat := pf24bit;
-
 
3061
      if BitCount >= 24 then {please accept the Alphachannel too}
-
 
3062
        TBitmap(Dest).PixelFormat := pf32bit;
-
 
3063
      TBitmap(Dest).Width := Width;
-
 
3064
      TBitmap(Dest).Height := Height;
-
 
3065
      TBitmap(Dest).Canvas.CopyRect(Rect(0, 0, TBitmap(Dest).Width, TBitmap(Dest).Height), Canvas, ClientRect);
-
 
3066
    finally
-
 
3067
      Canvas.Release;
-
 
3068
    end
-
 
3069
  end
-
 
3070
  else
1538
  if Dest is TDIB then
3071
  if Dest is TDIB then
1539
  begin
3072
  begin
-
 
3073
    try
-
 
3074
      if BitCount >= 24 then {please accept the Alphachannel too}
-
 
3075
        TDIB(Dest).SetSize(Width, Height, BitCount)
-
 
3076
      else
1540
    TDIB(Dest).SetSize(Width, Height, 24);
3077
        TDIB(Dest).SetSize(Width, Height, 24);
1541
    TDIB(Dest).Canvas.CopyRect(Rect(0, 0, TDIB(Dest).Width, TDIB(Dest).Height), Canvas, ClientRect);
3078
      TDIB(Dest).Canvas.CopyRect(Rect(0, 0, TDIB(Dest).Width, TDIB(Dest).Height), Canvas, ClientRect);
-
 
3079
    finally
1542
    Canvas.Release;
3080
      Canvas.Release;
-
 
3081
    end
1543
  end else
3082
  end else
1544
    inherited AssignTo(Dest);
3083
    inherited AssignTo(Dest);
1545
end;
3084
end;
1546
 
3085
 
1547
function TDirectDrawSurface.Blt(const DestRect, SrcRect: TRect; Flags: DWORD;
3086
function TDirectDrawSurface.Blt(const DestRect, SrcRect: TRect; Flags: DWORD;
1548
  const DF: TDDBltFX; Source: TDirectDrawSurface): Boolean;
3087
  const DF: TDDBltFX; Source: TDirectDrawSurface): Boolean;
1549
begin
3088
begin
1550
  if IDDSurface<>nil then
3089
  if {$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF} <> nil then
1551
  begin
3090
  begin
1552
    DXResult := ISurface.Blt(DestRect, Source.IDDSurface, SrcRect, DWORD(Flags), DF);
3091
    DXResult := {$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF}.Blt(@DestRect, Source.{$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF}, @SrcRect, DWORD(Flags), @DF);
1553
    Result := DXResult=DD_OK;
3092
    Result := DXResult = DD_OK;
1554
  end else
3093
  end else
1555
    Result := False;
3094
    Result := False;
1556
end;
3095
end;
1557
 
3096
 
1558
function TDirectDrawSurface.BltFast(X, Y: Integer; const SrcRect: TRect;
3097
function TDirectDrawSurface.BltFast(X, Y: Integer; const SrcRect: TRect;
1559
  Flags: DWORD; Source: TDirectDrawSurface): Boolean;
3098
  Flags: DWORD; Source: TDirectDrawSurface): Boolean;
1560
begin
3099
begin
1561
  if IDDSurface<>nil then
3100
  if {$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF} <> nil then
1562
  begin
3101
  begin
1563
    DXResult := ISurface.BltFast(X, Y, Source.IDDSurface, SrcRect, DWORD(Flags));
3102
    DXResult := {$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF}.BltFast(X, Y, Source.{$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF}, @SrcRect, DWORD(Flags));
1564
    Result := DXResult=DD_OK;
3103
    Result := DXResult = DD_OK;
1565
  end else
3104
  end else
1566
    Result := False;
3105
    Result := False;
1567
end;
3106
end;
1568
 
3107
 
1569
function TDirectDrawSurface.ColorMatch(Col: TColor): Integer;
3108
function TDirectDrawSurface.ColorMatch(Col: TColor): Integer;
1570
var
3109
var
1571
  DIB: TDIB;
-
 
1572
  i, oldc: Integer;
3110
  i, oldc: Integer;
1573
begin
3111
begin
1574
  if IDDSurface<>nil then
3112
  if {$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF} <> nil then
1575
  begin
3113
  begin
1576
    oldc := Pixels[0, 0];
3114
    oldc := Pixels[0, 0];
1577
 
3115
 
1578
    DIB := TDIB.Create;
-
 
1579
    try
-
 
1580
      i := ColorToRGB(Col);
3116
      i := ColorToRGB(Col);
1581
      DIB.SetSize(1, 1, 8);
3117
      DIB_COLMATCH.SetSize(1, 1, 8);
1582
      DIB.ColorTable[0] := RGBQuad(GetRValue(i), GetGValue(i), GetBValue(i));
3118
      DIB_COLMATCH.ColorTable[0] := RGBQuad(GetRValue(i), GetGValue(i), GetBValue(i));
1583
      DIB.UpdatePalette;
3119
      DIB_COLMATCH.UpdatePalette;
1584
      DIB.Pixels[0, 0] := 0;
3120
      DIB_COLMATCH.Pixels[0, 0] := 0;
1585
 
3121
 
1586
      with Canvas do
3122
      with Canvas do
1587
      begin
3123
      try
1588
        Draw(0, 0, DIB);
3124
        Draw(0, 0, DIB_COLMATCH);
-
 
3125
      finally
1589
        Release;
3126
        Release;
1590
      end;
3127
      end;
1591
    finally
-
 
1592
      DIB.Free;
-
 
1593
    end;
3128
 
1594
    Result := Pixels[0, 0];
3129
    Result := Pixels[0, 0];
1595
    Pixels[0, 0] := oldc;
3130
    Pixels[0, 0] := oldc;
1596
  end else
3131
  end else
1597
    Result := 0;
3132
    Result := 0;
1598
end;
3133
end;
1599
 
3134
 
-
 
3135
{$IFDEF D3D_deprecated}
1600
function TDirectDrawSurface.CreateSurface(const SurfaceDesc: TDDSurfaceDesc): Boolean;
3136
function TDirectDrawSurface.CreateSurface(SurfaceDesc: TDDSurfaceDesc): Boolean;
1601
var
3137
var
1602
  TempSurface: IDirectDrawSurface;
3138
  TempSurface: IDirectDrawSurface;
1603
begin
3139
begin
1604
  IDDSurface := nil;
3140
  IDDSurface := nil;
1605
 
3141
 
1606
  FDDraw.DXResult := FDDraw.IDraw.CreateSurface(SurfaceDesc, TempSurface, nil);
3142
  FDDraw.DXResult := FDDraw.IDraw.CreateSurface(SurfaceDesc, TempSurface, nil);
1607
  FDXResult := FDDraw.DXResult;
3143
  FDXResult := FDDraw.DXResult;
1608
  Result := FDDraw.DXResult=DD_OK;
3144
  Result := FDDraw.DXResult = DD_OK;
1609
  if Result then
3145
  if Result then
1610
  begin
3146
  begin
1611
    IDDSurface := TempSurface;
3147
    IDDSurface := TempSurface;
1612
    TransparentColor := 0;
3148
    TransparentColor := 0;
1613
  end;
3149
  end;
1614
end;
3150
end;
1615
 
3151
{$ENDIF}
1616
{$IFDEF DelphiX_Spt4}
3152
{$IFDEF VER4UP}
1617
function TDirectDrawSurface.CreateSurface(const SurfaceDesc: TDDSurfaceDesc2): Boolean;
3153
function TDirectDrawSurface.CreateSurface(SurfaceDesc: TDDSurfaceDesc2): Boolean;
1618
var
3154
var
1619
  TempSurface4: IDirectDrawSurface4;
3155
  TempSurface: {$IFDEF D3D_deprecated}IDirectDrawSurface4{$ELSE}IDirectDrawSurface7{$ENDIF};
1620
begin
3156
begin
1621
  IDDSurface := nil;
3157
  {$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF} := nil;
1622
  FDDraw.DXResult := FDDraw.IDraw4.CreateSurface(SurfaceDesc, TempSurface4, nil);
3158
  FDDraw.DXResult := FDDraw.{$IFDEF D3D_deprecated}IDraw4{$ELSE}IDraw7{$ENDIF}.CreateSurface(SurfaceDesc, TempSurface, nil);
1623
  FDXResult := FDDraw.DXResult;
3159
  FDXResult := FDDraw.DXResult;
1624
  Result := FDDraw.DXResult=DD_OK;
3160
  Result := FDDraw.DXResult = DD_OK;
1625
  if Result then
3161
  if Result then
1626
  begin
3162
  begin
1627
    IDDSurface4 := TempSurface4;
3163
    {$IFDEF D3D_deprecated}IDDSurface4{$ELSE}IDDSurface7{$ENDIF} := TempSurface;
1628
    TransparentColor := 0;
3164
    TransparentColor := 0;
1629
  end;
3165
  end;
1630
end;
3166
end;
1631
{$ENDIF}
3167
{$ENDIF}
1632
 
3168
 
1633
procedure TDirectDrawSurface.Draw(X, Y: Integer; SrcRect: TRect; Source: TDirectDrawSurface;
3169
procedure TDirectDrawSurface.Draw(X, Y: Integer; SrcRect: TRect; Source: TDirectDrawSurface;
1634
  Transparent: Boolean);
3170
  Transparent: Boolean);
1635
const
3171
const
1636
  BltFastFlags: array[Boolean] of Integer =
3172
  BltFastFlags: array[Boolean] of Integer =
1637
    (DDBLTFAST_NOCOLORKEY or DDBLTFAST_WAIT, DDBLTFAST_SRCCOLORKEY or DDBLTFAST_WAIT);
3173
  (DDBLTFAST_NOCOLORKEY or DDBLTFAST_WAIT, DDBLTFAST_SRCCOLORKEY or DDBLTFAST_WAIT);
1638
  BltFlags: array[Boolean] of Integer =
3174
  BltFlags: array[Boolean] of Integer =
1639
    (DDBLT_WAIT, DDBLT_KEYSRC or DDBLT_WAIT);
3175
  (DDBLT_WAIT, DDBLT_KEYSRC or DDBLT_WAIT);
1640
var
3176
{$IFDEF DXR_deprecated}var
1641
  DestRect: TRect;
3177
  DestRect: TRect;
1642
  DF: TDDBltFX;
3178
  DF: TDDBltFX;
1643
  Clipper: IDirectDrawClipper;
3179
  Clipper: IDirectDrawClipper;
1644
  i: Integer;
3180
  i: Integer;{$ENDIF}
1645
begin
3181
begin
1646
  if Source<>nil then
3182
  if Source <> nil then
1647
  begin
3183
  begin
1648
    if (X>Width) or (Y>Height) then Exit;
3184
    if (X > Width) or (Y > Height) then Exit;
-
 
3185
{$IFDEF DrawHWAcc}
-
 
3186
    if AsSigned(D2D) and D2D.CanUseD2D and (D2D.FDDraw.Surface = Self) then
-
 
3187
    begin
-
 
3188
      {$IFDEF VER4UP}
-
 
3189
      D2D.D2DRenderDrawDDSXY(Source, X, Y, SrcRect, Transparent, 0, rtDraw{$IFNDEF VER4UP}, $FF{$ENDIF});
-
 
3190
      {$ELSE}
-
 
3191
      D2D.D2DRenderDDS(Source, SrcRect, Bounds(X, Y, SrcRect.Right - SrcRect.Left, SrcRect.Bottom - SrcRect.Top), Transparent, 0, rtDraw, $FF);
-
 
3192
      {$ENDIF}
-
 
3193
      Exit;
1649
 
3194
    end;
-
 
3195
{$ENDIF DrawHWAcc}
-
 
3196
    {$IFDEF DXR_deprecated}
1650
    if (SrcRect.Left>SrcRect.Right) or (SrcRect.Top>SrcRect.Bottom) then
3197
    if (SrcRect.Left > SrcRect.Right) or (SrcRect.Top > SrcRect.Bottom) then
1651
    begin
3198
    begin
1652
      {  Mirror  }
3199
      {  Mirror  }
1653
      if ((X+Abs(SrcRect.Left-SrcRect.Right))<=0) or
3200
      if ((X + Abs(SrcRect.Left - SrcRect.Right)) <= 0) or
1654
        ((Y+Abs(SrcRect.Top-SrcRect.Bottom))<=0) then Exit;
3201
        ((Y + Abs(SrcRect.Top - SrcRect.Bottom)) <= 0) then Exit;
1655
 
3202
 
1656
      DF.dwsize := SizeOf(DF);
3203
      DF.dwsize := SizeOf(DF);
1657
      DF.dwDDFX := 0;
3204
      DF.dwDDFX := 0;
1658
 
3205
 
1659
      if SrcRect.Left>SrcRect.Right then
3206
      if SrcRect.Left > SrcRect.Right then
1660
      begin
3207
      begin
1661
        i := SrcRect.Left; SrcRect.Left := SrcRect.Right; SrcRect.Right := i;
3208
        i := SrcRect.Left; SrcRect.Left := SrcRect.Right; SrcRect.Right := i;
1662
        DF.dwDDFX := DF.dwDDFX or DDBLTFX_MIRRORLEFTRIGHT;
3209
        DF.dwDDFX := DF.dwDDFX or DDBLTFX_MIRRORLEFTRIGHT;
1663
      end;
3210
      end;
1664
 
3211
 
1665
      if SrcRect.Top>SrcRect.Bottom then
3212
      if SrcRect.Top > SrcRect.Bottom then
1666
      begin
3213
      begin
1667
        i := SrcRect.Top; SrcRect.Top := SrcRect.Bottom; SrcRect.Bottom := i;
3214
        i := SrcRect.Top; SrcRect.Top := SrcRect.Bottom; SrcRect.Bottom := i;
1668
        DF.dwDDFX := DF.dwDDFX or DDBLTFX_MIRRORUPDOWN;
3215
        DF.dwDDFX := DF.dwDDFX or DDBLTFX_MIRRORUPDOWN;
1669
      end;
3216
      end;
1670
 
3217
 
1671
      with SrcRect do
3218
      with SrcRect do
1672
        DestRect := Bounds(X, Y, Right-Left, Bottom-Top);
3219
        DestRect := Bounds(X, Y, Right - Left, Bottom - Top);
1673
 
3220
 
1674
      if ClipRect2(DestRect, SrcRect, ClientRect, Source.ClientRect) then
3221
      if ClipRect2(DestRect, SrcRect, ClientRect, Source.ClientRect) then
1675
      begin
3222
      begin
1676
        if DF.dwDDFX and DDBLTFX_MIRRORLEFTRIGHT<>0 then
3223
        if DF.dwDDFX and DDBLTFX_MIRRORLEFTRIGHT <> 0 then
1677
        begin
3224
        begin
1678
          i := SrcRect.Left;
3225
          i := SrcRect.Left;
1679
          SrcRect.Left := Source.Width-SrcRect.Right;
3226
          SrcRect.Left := Source.Width - SrcRect.Right;
1680
          SrcRect.Right := Source.Width-i;
3227
          SrcRect.Right := Source.Width - i;
1681
        end;
3228
        end;
1682
 
3229
 
1683
        if DF.dwDDFX and DDBLTFX_MIRRORUPDOWN<>0 then
3230
        if DF.dwDDFX and DDBLTFX_MIRRORUPDOWN <> 0 then
1684
        begin
3231
        begin
1685
          i := SrcRect.Top;
3232
          i := SrcRect.Top;
1686
          SrcRect.Top := Source.Height-SrcRect.Bottom;
3233
          SrcRect.Top := Source.Height - SrcRect.Bottom;
1687
          SrcRect.Bottom := Source.Height-i;
3234
          SrcRect.Bottom := Source.Height - i;
1688
        end;
3235
        end;
1689
                                                   
-
 
-
 
3236
 
1690
        Blt(DestRect, SrcRect, BltFlags[Transparent] or DDBLT_DDFX, df, Source);
3237
        Blt(DestRect, SrcRect, BltFlags[Transparent] or DDBLT_DDFX, df, Source);
1691
      end;
3238
      end;
1692
    end else
3239
    end else
1693
    begin
3240
    begin
1694
      with SrcRect do
3241
      with SrcRect do
1695
        DestRect := Bounds(X, Y, Right-Left, Bottom-Top);
3242
        DestRect := Bounds(X, Y, Right - Left, Bottom - Top);
1696
 
3243
 
1697
      if ClipRect2(DestRect, SrcRect, ClientRect, Source.ClientRect) then
3244
      if ClipRect2(DestRect, SrcRect, ClientRect, Source.ClientRect) then
1698
      begin
3245
      begin
1699
        if FHasClipper then
3246
        if FHasClipper then
1700
        begin
3247
        begin
Line 1702... Line 3249...
1702
          DF.dwDDFX := 0;
3249
          DF.dwDDFX := 0;
1703
          Blt(DestRect, SrcRect, BltFlags[Transparent], df, Source);
3250
          Blt(DestRect, SrcRect, BltFlags[Transparent], df, Source);
1704
        end else
3251
        end else
1705
        begin
3252
        begin
1706
          BltFast(DestRect.Left, DestRect.Top, SrcRect, BltFastFlags[Transparent], Source);
3253
          BltFast(DestRect.Left, DestRect.Top, SrcRect, BltFastFlags[Transparent], Source);
1707
          if DXResult=DDERR_BLTFASTCANTCLIP then
3254
          if DXResult = DDERR_BLTFASTCANTCLIP then
1708
          begin
3255
          begin
1709
            ISurface.GetClipper(Clipper);
3256
            {$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}.GetClipper(Clipper);
1710
            if Clipper<>nil then FHasClipper := True;
3257
            if Clipper <> nil then FHasClipper := True;
1711
 
3258
 
1712
            DF.dwsize := SizeOf(DF);
3259
            DF.dwsize := SizeOf(DF);
1713
            DF.dwDDFX := 0;
3260
            DF.dwDDFX := 0;
1714
            Blt(DestRect, SrcRect, BltFlags[Transparent], df, Source);
3261
            Blt(DestRect, SrcRect, BltFlags[Transparent], df, Source);
1715
          end;
3262
          end;
1716
        end;
3263
        end;
1717
      end;
3264
      end;
1718
    end;
3265
    end;
-
 
3266
    {$ENDIF}
1719
  end;
3267
  end;
1720
end;
3268
end;
1721
 
3269
 
1722
{$IFDEF DelphiX_Spt4}
3270
{$IFDEF VER4UP}
1723
procedure TDirectDrawSurface.Draw(X, Y: Integer; Source: TDirectDrawSurface; Transparent: Boolean);
3271
procedure TDirectDrawSurface.Draw(X, Y: Integer; Source: TDirectDrawSurface; Transparent: Boolean);
1724
const
3272
const
1725
  BltFastFlags: array[Boolean] of Integer =
3273
  BltFastFlags: array[Boolean] of Integer =
1726
    (DDBLTFAST_NOCOLORKEY or DDBLTFAST_WAIT, DDBLTFAST_SRCCOLORKEY or DDBLTFAST_WAIT);
3274
  (DDBLTFAST_NOCOLORKEY or DDBLTFAST_WAIT, DDBLTFAST_SRCCOLORKEY or DDBLTFAST_WAIT);
1727
  BltFlags: array[Boolean] of Integer =
3275
  BltFlags: array[Boolean] of Integer =
1728
    (DDBLT_WAIT, DDBLT_KEYSRC or DDBLT_WAIT);
3276
  (DDBLT_WAIT, DDBLT_KEYSRC or DDBLT_WAIT);
1729
var
3277
var
1730
  DestRect, SrcRect: TRect;
3278
  DestRect, SrcRect: TRect;
1731
  DF: TDDBltFX;
3279
  {$IFDEF DXR_deprecated}DF: TDDBltFX;
1732
  Clipper: IDirectDrawClipper;
3280
  Clipper: IDirectDrawClipper;{$ENDIF}
1733
begin
3281
begin
1734
  if Source<>nil then
3282
  if Source <> nil then
1735
  begin
3283
  begin
1736
    SrcRect := Source.ClientRect;
3284
    SrcRect := Source.ClientRect;
1737
    DestRect := Bounds(X, Y, Source.Width, Source.Height);
3285
    DestRect := Bounds(X, Y, Source.Width, Source.Height);
-
 
3286
    {$IFDEF DrawHWAcc}
-
 
3287
    if AsSigned(D2D) and D2D.CanUseD2D and (D2D.FDDraw.Surface = Self) then begin
-
 
3288
      D2D.D2DRenderDDS(Source, ZeroRect, DestRect, Transparent, 0, rtDraw{$IFNDEF VER4UP}, $FF{$ENDIF});
-
 
3289
      Exit;
1738
 
3290
    end;
-
 
3291
    {$ENDIF DrawHWAcc}
-
 
3292
    {$IFDEF DXR_deprecated}
1739
    if ClipRect2(DestRect, SrcRect, ClientRect, Source.ClientRect) then
3293
    if ClipRect2(DestRect, SrcRect, ClientRect, Source.ClientRect) then
1740
    begin
3294
    begin
1741
      if FHasClipper then
3295
      if FHasClipper then
1742
      begin
3296
      begin
1743
        DF.dwsize := SizeOf(DF);
3297
        DF.dwsize := SizeOf(DF);
1744
        DF.dwDDFX := 0;
3298
        DF.dwDDFX := 0;
1745
        Blt(DestRect, SrcRect, BltFlags[Transparent], df, Source);
3299
        Blt(DestRect, SrcRect, BltFlags[Transparent], df, Source);
1746
      end else
3300
      end else
1747
      begin
3301
      begin
1748
        BltFast(DestRect.Left, DestRect.Top, SrcRect, BltFastFlags[Transparent], Source);
3302
        BltFast(DestRect.Left, DestRect.Top, SrcRect, BltFastFlags[Transparent], Source);
1749
        if DXResult=DDERR_BLTFASTCANTCLIP then
3303
        if DXResult = DDERR_BLTFASTCANTCLIP then
1750
        begin
3304
        begin
1751
          ISurface.GetClipper(Clipper);
3305
          {$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}.GetClipper(Clipper);
1752
          if Clipper<>nil then FHasClipper := True;
3306
          if Clipper <> nil then FHasClipper := True;
1753
 
3307
 
1754
          DF.dwsize := SizeOf(DF);
3308
          DF.dwsize := SizeOf(DF);
1755
          DF.dwDDFX := 0;
3309
          DF.dwDDFX := 0;
1756
          Blt(DestRect, SrcRect, BltFlags[Transparent], df, Source);
3310
          Blt(DestRect, SrcRect, BltFlags[Transparent], df, Source);
1757
        end;
3311
        end;
1758
      end;
3312
      end;
1759
    end;
3313
    end;
-
 
3314
    {$ENDIF}
1760
  end;
3315
  end;
1761
end;
3316
end;
1762
{$ENDIF}
3317
{$ENDIF}
1763
 
3318
 
1764
procedure TDirectDrawSurface.StretchDraw(const DestRect, SrcRect: TRect; Source: TDirectDrawSurface;
3319
procedure TDirectDrawSurface.StretchDraw(const DestRect, SrcRect: TRect; Source: TDirectDrawSurface;
1765
  Transparent: Boolean);
3320
  Transparent: Boolean);
1766
const
3321
const
1767
  BltFlags: array[Boolean] of Integer =
3322
  BltFlags: array[Boolean] of Integer =
1768
    (DDBLT_WAIT, DDBLT_KEYSRC or DDBLT_WAIT);
3323
  (DDBLT_WAIT, DDBLT_KEYSRC or DDBLT_WAIT);
1769
var
3324
{$IFDEF DXR_deprecated}var
1770
  DF: TDDBltFX;
3325
  DF: TDDBltFX;
1771
  OldClipper: IDirectDrawClipper;
3326
  OldClipper: IDirectDrawClipper;
1772
  Clipper: TDirectDrawClipper;
3327
  Clipper: TDirectDrawClipper;{$ENDIF}
1773
begin
3328
begin
1774
  if Source<>nil then
3329
  if Source <> nil then
1775
  begin
3330
  begin
1776
    if (DestRect.Bottom<=DestRect.Top) or (DestRect.Right<=DestRect.Left) then Exit;
3331
    if (DestRect.Bottom <= DestRect.Top) or (DestRect.Right <= DestRect.Left) then Exit;
1777
    if (SrcRect.Bottom<=SrcRect.Top) or (SrcRect.Right<=SrcRect.Left) then Exit;
3332
    if (SrcRect.Bottom <= SrcRect.Top) or (SrcRect.Right <= SrcRect.Left) then Exit;
-
 
3333
    {$IFDEF DrawHWAcc}
-
 
3334
    if AsSigned(D2D) and D2D.CanUseD2D and (D2D.FDDraw.Surface = Self) then begin
-
 
3335
      D2D.D2DRenderDDS(Source, SrcRect, DestRect, Transparent, 0, rtDraw{$IFNDEF VER4UP}, $FF{$ENDIF});
-
 
3336
      Exit;
1778
 
3337
    end;
-
 
3338
    {$ENDIF DrawHWAcc}
-
 
3339
    {$IFDEF DXR_deprecated}
1779
    if FHasClipper then
3340
    if FHasClipper then
1780
    begin
3341
    begin
1781
      DF.dwsize := SizeOf(DF);
3342
      DF.dwsize := SizeOf(DF);
1782
      DF.dwDDFX := 0;
3343
      DF.dwDDFX := 0;
1783
      Blt(DestRect, SrcRect, BltFlags[Transparent], df, Source);
3344
      Blt(DestRect, SrcRect, BltFlags[Transparent], df, Source);
1784
    end else
3345
    end else
1785
    begin
3346
    begin
1786
      if FStretchDrawClipper=nil then
3347
      if FStretchDrawClipper = nil then
1787
      begin
3348
      begin
1788
        Clipper := TDirectDrawClipper.Create(DDraw);
3349
        Clipper := TDirectDrawClipper.Create(DDraw);
1789
        try
3350
        try
1790
          Clipper.SetClipRects([ClientRect]);
3351
          Clipper.SetClipRects([ClientRect]);
1791
          FStretchDrawClipper := Clipper.IClipper;
3352
          FStretchDrawClipper := Clipper.IClipper;
1792
        finally
3353
        finally
1793
          Clipper.Free;
3354
          Clipper.Free;
1794
        end;
3355
        end;
1795
      end;
3356
      end;
1796
 
3357
 
1797
      ISurface.GetClipper(OldClipper);
3358
      {$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}.GetClipper(OldClipper);
1798
      ISurface.SetClipper(FStretchDrawClipper);
3359
      {$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}.SetClipper(FStretchDrawClipper);
1799
      DF.dwsize := SizeOf(DF);
3360
      DF.dwsize := SizeOf(DF);
1800
      DF.dwDDFX := 0;
3361
      DF.dwDDFX := 0;
1801
      Blt(DestRect, SrcRect, BltFlags[Transparent], df, Source);
3362
      Blt(DestRect, SrcRect, BltFlags[Transparent], df, Source);
1802
      ISurface.SetClipper(nil);
3363
      {$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}.SetClipper(nil);
1803
    end;
3364
    end;
-
 
3365
    {$ENDIF}
1804
  end;
3366
  end;
1805
end;
3367
end;
1806
 
3368
 
1807
{$IFDEF DelphiX_Spt4}
3369
{$IFDEF VER4UP}
1808
procedure TDirectDrawSurface.StretchDraw(const DestRect: TRect; Source: TDirectDrawSurface;
3370
procedure TDirectDrawSurface.StretchDraw(const DestRect: TRect; Source: TDirectDrawSurface;
1809
  Transparent: Boolean);
3371
  Transparent: Boolean);
1810
const
3372
const
1811
  BltFlags: array[Boolean] of Integer =
-
 
1812
 
-
 
1813
    (DDBLT_WAIT, DDBLT_KEYSRC or DDBLT_WAIT);
3373
  BltFlags: array[Boolean] of Integer = (DDBLT_WAIT, DDBLT_KEYSRC or DDBLT_WAIT);
1814
var
3374
var
1815
  DF: TDDBltFX;
3375
  {$IFDEF DXR_deprecated}DF: TDDBltFX;
1816
  OldClipper: IDirectDrawClipper;
3376
  OldClipper: IDirectDrawClipper;
1817
  Clipper: TDirectDrawClipper;
3377
  Clipper: TDirectDrawClipper;{$ENDIF}
1818
  SrcRect: TRect;
3378
  SrcRect: TRect;
1819
begin                                                
3379
begin
1820
  if Source<>nil then
3380
  if Source <> nil then
1821
  begin
3381
  begin
1822
    if (DestRect.Bottom<=DestRect.Top) or (DestRect.Right<=DestRect.Left) then Exit;
3382
    if (DestRect.Bottom <= DestRect.Top) or (DestRect.Right <= DestRect.Left) then Exit;
1823
    SrcRect := Source.ClientRect;
3383
    SrcRect := Source.ClientRect;
1824
 
3384
 
-
 
3385
    if AsSigned(D2D) and D2D.CanUseD2D and (D2D.FDDraw.Surface = Self) then begin
-
 
3386
      D2D.D2DRenderDDS(Source, ZeroRect, DestRect, Transparent, 0, rtDraw{$IFNDEF VER4UP}, $FF{$ENDIF});
-
 
3387
      Exit;
-
 
3388
    end;
-
 
3389
    {$IFDEF DXR_deprecated}
1825
    if ISurface.GetClipper(OldClipper)=DD_OK then
3390
    if {$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}.GetClipper(OldClipper) = DD_OK then
1826
    begin
3391
    begin
1827
      DF.dwsize := SizeOf(DF);
3392
      DF.dwsize := SizeOf(DF);
1828
      DF.dwDDFX := 0;
3393
      DF.dwDDFX := 0;
1829
      Blt(DestRect, SrcRect, BltFlags[Transparent], df, Source);
3394
      Blt(DestRect, SrcRect, BltFlags[Transparent], df, Source);
1830
    end else
3395
    end else
1831
    begin
3396
    begin
1832
      if FStretchDrawClipper=nil then
3397
      if FStretchDrawClipper = nil then
1833
      begin
3398
      begin
1834
        Clipper := TDirectDrawClipper.Create(DDraw);
3399
        Clipper := TDirectDrawClipper.Create(DDraw);
1835
        try
3400
        try
1836
          Clipper.SetClipRects([ClientRect]);
3401
          Clipper.SetClipRects([ClientRect]);
1837
          FStretchDrawClipper := Clipper.IClipper;
3402
          FStretchDrawClipper := Clipper.IClipper;
1838
        finally
3403
        finally
1839
          Clipper.Free;
3404
          Clipper.Free;
1840
        end;
3405
        end;
1841
      end;
3406
      end;
1842
 
3407
 
1843
      ISurface.SetClipper(FStretchDrawClipper);
3408
      {$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}.SetClipper(FStretchDrawClipper);
1844
      try
3409
      try
1845
        DF.dwsize := SizeOf(DF);
3410
        DF.dwsize := SizeOf(DF);
1846
        DF.dwDDFX := 0;
3411
        DF.dwDDFX := 0;
1847
        Blt(DestRect, SrcRect, BltFlags[Transparent], df, Source);
3412
        Blt(DestRect, SrcRect, BltFlags[Transparent], df, Source);
1848
      finally
3413
      finally
1849
        ISurface.SetClipper(nil);
3414
        {$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}.SetClipper(nil);
1850
      end;
3415
      end;
1851
    end;
3416
    end;
-
 
3417
    {$ENDIF}
1852
  end;
3418
  end;
1853
 end;
3419
end;
1854
{$ENDIF}
3420
{$ENDIF}
1855
 
3421
 
1856
procedure TDirectDrawSurface.DrawAdd(const DestRect, SrcRect: TRect; Source: TDirectDrawSurface;
3422
procedure TDirectDrawSurface.DrawAdd(const DestRect, SrcRect: TRect; Source: TDirectDrawSurface;
1857
  Transparent: Boolean; Alpha: Integer);
3423
  Transparent: Boolean; Alpha: Integer);
1858
var
3424
{$IFDEF DXR_deprecated}var
1859
  Src_ddsd: TDDSurfaceDesc;
3425
  Src_ddsd: {$IFDEF D3D_deprecated}TDDSurfaceDesc{$ELSE}TDDSurfaceDesc2{$ENDIF};
1860
  DestSurface, SrcSurface: TDXR_Surface;
3426
  DestSurface, SrcSurface: TDXR_Surface;
1861
  Blend: TDXR_Blend;
3427
  Blend: TDXR_Blend;{$ENDIF}
1862
begin
3428
begin
1863
  if (Self.Width=0) or (Self.Height=0) then Exit;
3429
  if (Self.Width = 0) or (Self.Height = 0) then Exit;
1864
  if (Width=0) or (Height=0) then Exit;
3430
  if (Width = 0) or (Height = 0) then Exit;
1865
  if Source=nil then Exit;
3431
  if Source = nil then Exit;
1866
  if (Source.Width=0) or (Source.Height=0) then Exit;
3432
  if (Source.Width = 0) or (Source.Height = 0) then Exit;
1867
 
3433
 
1868
  if Alpha<=0 then Exit;
3434
  if Alpha <= 0 then Exit;
1869
 
3435
 
-
 
3436
  if AsSigned(D2D) and D2D.CanUseD2D and (D2D.FDDraw.Surface = Self) then begin
-
 
3437
    D2D.D2DRenderDDS(Source, SrcRect, DestRect, Transparent, 0, rtAdd, Alpha);
-
 
3438
    Exit;
-
 
3439
  end;
-
 
3440
  {$IFDEF DXR_deprecated}
1870
  if dxrDDSurfaceLock(ISurface, DestSurface) then
3441
  if dxrDDSurfaceLock({$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, DestSurface) then
1871
  begin
3442
  begin
1872
    try
3443
    try
1873
      if dxrDDSurfaceLock2(Source.ISurface, Src_ddsd, SrcSurface) then
3444
      if dxrDDSurfaceLock2(Source.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, Src_ddsd, SrcSurface) then
1874
      begin
3445
      begin
1875
        try
3446
        try
1876
          if DestSurface.ColorType=DXR_COLORTYPE_INDEXED then
3447
          if DestSurface.ColorType = DXR_COLORTYPE_INDEXED then
1877
          begin
3448
          begin
1878
            Blend := DXR_BLEND_ONE1;
3449
            Blend := DXR_BLEND_ONE1;
1879
          end else
3450
          end else
1880
          if Alpha>=255 then
3451
            if Alpha >= 255 then
1881
          begin
3452
            begin
1882
            Blend := DXR_BLEND_ONE1_ADD_ONE2;
3453
              Blend := DXR_BLEND_ONE1_ADD_ONE2;
1883
          end else
3454
            end else
1884
          begin
3455
            begin
1885
            Blend := DXR_BLEND_SRCALPHA1_ADD_ONE2;
3456
              Blend := DXR_BLEND_SRCALPHA1_ADD_ONE2;
1886
          end;
3457
            end;
1887
 
3458
 
1888
          dxrCopyRectBlend(DestSurface, SrcSurface,
3459
          dxrCopyRectBlend(DestSurface, SrcSurface,
1889
            DestRect, SrcRect, Blend, Alpha, Transparent, Src_ddsd.ddckCKSrcBlt.dwColorSpaceLowValue);
3460
            DestRect, SrcRect, Blend, Alpha, Transparent, Src_ddsd.ddckCKSrcBlt.dwColorSpaceLowValue);
1890
        finally
3461
        finally
1891
          dxrDDSurfaceUnLock(Source.ISurface, SrcSurface)
3462
          dxrDDSurfaceUnLock(Source.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, SrcSurface)
1892
        end;
3463
        end;
1893
      end;
3464
      end;
1894
    finally
3465
    finally
1895
      dxrDDSurfaceUnLock(ISurface, DestSurface)
3466
      dxrDDSurfaceUnLock({$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, DestSurface)
1896
    end;
3467
    end;
1897
  end;
3468
  end;
-
 
3469
  {$ENDIF}
1898
end;
3470
end;
1899
 
3471
 
1900
procedure TDirectDrawSurface.DrawAlpha(const DestRect, SrcRect: TRect; Source: TDirectDrawSurface;
3472
procedure TDirectDrawSurface.DrawAlpha(const DestRect, SrcRect: TRect; Source: TDirectDrawSurface;
1901
  Transparent: Boolean; Alpha: Integer);
3473
  Transparent: Boolean; Alpha: Integer);
1902
var
3474
{$IFDEF DXR_deprecated}var
1903
  Src_ddsd: TDDSurfaceDesc;
3475
  Src_ddsd: {$IFDEF D3D_deprecated}TDDSurfaceDesc{$ELSE}TDDSurfaceDesc2{$ENDIF};
1904
  DestSurface, SrcSurface: TDXR_Surface;
3476
  DestSurface, SrcSurface: TDXR_Surface;
1905
  Blend: TDXR_Blend;
3477
  Blend: TDXR_Blend;{$ENDIF}
1906
begin
3478
begin
1907
  if (Self.Width=0) or (Self.Height=0) then Exit;
3479
  if (Self.Width = 0) or (Self.Height = 0) then Exit;
1908
  if (Width=0) or (Height=0) then Exit;
3480
  if (Width = 0) or (Height = 0) then Exit;
1909
  if Source=nil then Exit;
3481
  if Source = nil then Exit;
1910
  if (Source.Width=0) or (Source.Height=0) then Exit;
3482
  if (Source.Width = 0) or (Source.Height = 0) then Exit;
1911
 
3483
 
1912
  if Alpha<=0 then Exit;
3484
  if Alpha <= 0 then Exit;
1913
 
3485
 
-
 
3486
  if AsSigned(D2D) and D2D.CanUseD2D and (D2D.FDDraw.Surface = Self) then begin
-
 
3487
    D2D.D2DRenderDDS(Source, SrcRect, DestRect, Transparent, 0, rtBlend, Alpha);
-
 
3488
    Exit;
-
 
3489
  end;
-
 
3490
  {$IFDEF DXR_deprecated}
1914
  if dxrDDSurfaceLock(ISurface, DestSurface) then
3491
  if dxrDDSurfaceLock({$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, DestSurface) then
1915
  begin
3492
  begin
1916
    try
3493
    try
1917
      if dxrDDSurfaceLock2(Source.ISurface, Src_ddsd, SrcSurface) then
3494
      if dxrDDSurfaceLock2(Source.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, Src_ddsd, SrcSurface) then
1918
      begin
3495
      begin
1919
        try
3496
        try
1920
          if DestSurface.ColorType=DXR_COLORTYPE_INDEXED then
3497
          if DestSurface.ColorType = DXR_COLORTYPE_INDEXED then
1921
          begin
3498
          begin
1922
            Blend := DXR_BLEND_ONE1;
3499
            Blend := DXR_BLEND_ONE1;
1923
          end else
3500
          end else
1924
          if Alpha>=255 then
3501
            if Alpha >= 255 then
1925
          begin
3502
            begin
1926
            Blend := DXR_BLEND_ONE1;
3503
              Blend := DXR_BLEND_ONE1;
1927
          end else
3504
            end else
1928
          begin
3505
            begin
1929
            Blend := DXR_BLEND_SRCALPHA1_ADD_INVSRCALPHA2;
3506
              Blend := DXR_BLEND_SRCALPHA1_ADD_INVSRCALPHA2;
1930
          end;
3507
            end;
1931
 
3508
 
1932
          dxrCopyRectBlend(DestSurface, SrcSurface,
3509
          dxrCopyRectBlend(DestSurface, SrcSurface,
1933
            DestRect, SrcRect, Blend, Alpha, Transparent, Src_ddsd.ddckCKSrcBlt.dwColorSpaceLowValue);
3510
            DestRect, SrcRect, Blend, Alpha, Transparent, Src_ddsd.ddckCKSrcBlt.dwColorSpaceLowValue);
1934
        finally
3511
        finally
1935
          dxrDDSurfaceUnLock(Source.ISurface, SrcSurface)
3512
          dxrDDSurfaceUnLock(Source.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, SrcSurface)
1936
        end;
3513
        end;
1937
      end;
3514
      end;
1938
    finally
3515
    finally
1939
      dxrDDSurfaceUnLock(ISurface, DestSurface)
3516
      dxrDDSurfaceUnLock({$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, DestSurface)
1940
    end;
3517
    end;
1941
  end;
3518
  end;
-
 
3519
  {$ENDIF}
1942
end;
3520
end;
1943
 
3521
 
1944
procedure TDirectDrawSurface.DrawSub(const DestRect, SrcRect: TRect; Source: TDirectDrawSurface;
3522
procedure TDirectDrawSurface.DrawSub(const DestRect, SrcRect: TRect; Source: TDirectDrawSurface;
1945
  Transparent: Boolean; Alpha: Integer);
3523
  Transparent: Boolean; Alpha: Integer);
1946
var
3524
{$IFDEF DXR_deprecated}var
1947
  Src_ddsd: TDDSurfaceDesc;
3525
  Src_ddsd: {$IFDEF D3D_deprecated}TDDSurfaceDesc{$ELSE}TDDSurfaceDesc2{$ENDIF};
1948
  DestSurface, SrcSurface: TDXR_Surface;
3526
  DestSurface, SrcSurface: TDXR_Surface;
1949
  Blend: TDXR_Blend;
3527
  Blend: TDXR_Blend;{$ENDIF}
1950
begin
3528
begin
1951
  if (Self.Width=0) or (Self.Height=0) then Exit;
3529
  if (Self.Width = 0) or (Self.Height = 0) then Exit;
1952
  if (Width=0) or (Height=0) then Exit;
3530
  if (Width = 0) or (Height = 0) then Exit;
1953
  if Source=nil then Exit;
3531
  if Source = nil then Exit;
1954
  if (Source.Width=0) or (Source.Height=0) then Exit;
3532
  if (Source.Width = 0) or (Source.Height = 0) then Exit;
1955
 
3533
 
1956
  if Alpha<=0 then Exit;
3534
  if Alpha <= 0 then Exit;
1957
 
3535
 
-
 
3536
  if AsSigned(D2D) and D2D.CanUseD2D and (D2D.FDDraw.Surface = Self) then begin
-
 
3537
    D2D.D2DRenderDDS(Source, SrcRect, DestRect, Transparent, 0, rtSub, Alpha);
-
 
3538
    Exit;
-
 
3539
  end;
-
 
3540
  {$IFDEF DXR_deprecated}
1958
  if dxrDDSurfaceLock(ISurface, DestSurface) then
3541
  if dxrDDSurfaceLock({$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, DestSurface) then
1959
  begin
3542
  begin
1960
    try
3543
    try
1961
      if dxrDDSurfaceLock2(Source.ISurface, Src_ddsd, SrcSurface) then
3544
      if dxrDDSurfaceLock2(Source.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, Src_ddsd, SrcSurface) then
1962
      begin
3545
      begin
1963
        try
3546
        try
1964
          if DestSurface.ColorType=DXR_COLORTYPE_INDEXED then
3547
          if DestSurface.ColorType = DXR_COLORTYPE_INDEXED then
1965
          begin
3548
          begin
1966
            Blend := DXR_BLEND_ONE1;
3549
            Blend := DXR_BLEND_ONE1;
1967
          end else
3550
          end else
1968
          if Alpha>=255 then
3551
            if Alpha >= 255 then
1969
          begin
3552
            begin
1970
            Blend := DXR_BLEND_ONE2_SUB_ONE1;
3553
              Blend := DXR_BLEND_ONE2_SUB_ONE1;
1971
          end else
3554
            end else
1972
          begin
3555
            begin
1973
            Blend := DXR_BLEND_ONE2_SUB_SRCALPHA1;
3556
              Blend := DXR_BLEND_ONE2_SUB_SRCALPHA1;
1974
          end;
3557
            end;
1975
 
3558
 
1976
          dxrCopyRectBlend(DestSurface, SrcSurface,
3559
          dxrCopyRectBlend(DestSurface, SrcSurface,
1977
            DestRect, SrcRect, Blend, Alpha, Transparent, Src_ddsd.ddckCKSrcBlt.dwColorSpaceLowValue);
3560
            DestRect, SrcRect, Blend, Alpha, Transparent, Src_ddsd.ddckCKSrcBlt.dwColorSpaceLowValue);
1978
        finally
3561
        finally
1979
          dxrDDSurfaceUnLock(Source.ISurface, SrcSurface)
3562
          dxrDDSurfaceUnLock(Source.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, SrcSurface)
1980
        end;
3563
        end;
1981
      end;
3564
      end;
1982
    finally
3565
    finally
1983
      dxrDDSurfaceUnLock(ISurface, DestSurface)
3566
      dxrDDSurfaceUnLock({$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, DestSurface)
1984
    end;
3567
    end;
1985
  end;
3568
  end;
-
 
3569
  {$ENDIF}
1986
end;
3570
end;
1987
 
3571
 
1988
procedure TDirectDrawSurface.DrawRotate(X, Y, Width, Height: Integer; const SrcRect: TRect;
3572
procedure TDirectDrawSurface.DrawAlphaCol(const DestRect, SrcRect: TRect;
1989
  Source: TDirectDrawSurface; CenterX, CenterY: Double; Transparent: Boolean; Angle: Integer);
3573
  Source: TDirectDrawSurface; Transparent: Boolean; Color, Alpha: Integer);
-
 
3574
begin
-
 
3575
  if (Self.Width = 0) or (Self.Height = 0) then Exit;
-
 
3576
  if (Width = 0) or (Height = 0) then Exit;
-
 
3577
  if Source = nil then Exit;
-
 
3578
  if (Source.Width = 0) or (Source.Height = 0) then Exit;
-
 
3579
 
-
 
3580
  if Alpha <= 0 then Exit;
-
 
3581
 
-
 
3582
  if AsSigned(D2D) and D2D.CanUseD2D and (D2D.FDDraw.Surface = Self) then begin
-
 
3583
    D2D.D2DRenderColDDS(Source, SrcRect, DestRect, Transparent, 0, Color, rtBlend, Alpha);
-
 
3584
    Exit;
-
 
3585
  end;
-
 
3586
 
-
 
3587
  // If no hardware acceleration, falls back to non-color DrawAlpha
-
 
3588
  Self.DrawAlpha(DestRect, SrcRect, Source, Transparent, Alpha);
1990
var
3589
end;
-
 
3590
 
-
 
3591
procedure TDirectDrawSurface.DrawSubCol(const DestRect, SrcRect: TRect;
-
 
3592
  Source: TDirectDrawSurface; Transparent: Boolean; Color, Alpha: Integer);
-
 
3593
begin
-
 
3594
  if (Self.Width = 0) or (Self.Height = 0) then Exit;
-
 
3595
  if (Width = 0) or (Height = 0) then Exit;
-
 
3596
  if Source = nil then Exit;
-
 
3597
  if (Source.Width = 0) or (Source.Height = 0) then Exit;
-
 
3598
 
1991
  Src_ddsd: TDDSurfaceDesc;
3599
  if Alpha <= 0 then Exit;
-
 
3600
 
-
 
3601
  if AsSigned(D2D) and D2D.CanUseD2D and (D2D.FDDraw.Surface = Self) then begin
-
 
3602
    D2D.D2DRenderColDDS(Source, SrcRect, DestRect, Transparent, 0, Color, rtSub, Alpha);
-
 
3603
    Exit;
-
 
3604
  end;
-
 
3605
 
-
 
3606
  // If no hardware acceleration, falls back to non-color DrawSub
1992
  DestSurface, SrcSurface: TDXR_Surface;
3607
  Self.DrawSub(DestRect, SrcRect, Source, Transparent, Alpha);
-
 
3608
end;
-
 
3609
 
-
 
3610
procedure TDirectDrawSurface.DrawAddCol(const DestRect, SrcRect: TRect;
-
 
3611
  Source: TDirectDrawSurface; Transparent: Boolean; Color, Alpha: Integer);
1993
begin
3612
begin
1994
  if (Self.Width=0) or (Self.Height=0) then Exit;
3613
  if (Self.Width = 0) or (Self.Height = 0) then Exit;
1995
  if (Width=0) or (Height=0) then Exit;
3614
  if (Width = 0) or (Height = 0) then Exit;
1996
  if Source=nil then Exit;
3615
  if Source = nil then Exit;
1997
  if (Source.Width=0) or (Source.Height=0) then Exit;
3616
  if (Source.Width = 0) or (Source.Height = 0) then Exit;
-
 
3617
 
-
 
3618
  if Alpha <= 0 then Exit;
1998
 
3619
 
-
 
3620
  if AsSigned(D2D) and D2D.CanUseD2D and (D2D.FDDraw.Surface = Self) then begin
-
 
3621
    D2D.D2DRenderColDDS(Source, SrcRect, DestRect, Transparent, 0, Color, rtAdd, Alpha);
-
 
3622
    Exit;
-
 
3623
  end;
-
 
3624
 
-
 
3625
  // If no hardware acceleration, falls back to non-color DrawAdd
-
 
3626
  Self.DrawAdd(DestRect, SrcRect, Source, Transparent, Alpha);
-
 
3627
 
-
 
3628
end;
-
 
3629
 
-
 
3630
procedure TDirectDrawSurface.DrawRotate(X, Y, Width, Height: Integer; const SrcRect: TRect;
-
 
3631
  Source: TDirectDrawSurface; CenterX, CenterY: Double; Transparent: Boolean; Angle: single);
-
 
3632
{$IFDEF DXR_deprecated}var
-
 
3633
  Src_ddsd: {$IFDEF D3D_deprecated}TDDSurfaceDesc{$ELSE}TDDSurfaceDesc2{$ENDIF};
1999
  if dxrDDSurfaceLock(ISurface, DestSurface) then
3634
  DestSurface, SrcSurface: TDXR_Surface;{$ENDIF}
-
 
3635
begin
-
 
3636
  if (Self.Width = 0) or (Self.Height = 0) then Exit;
-
 
3637
  if (Width = 0) or (Height = 0) then Exit;
-
 
3638
  if Source = nil then Exit;
-
 
3639
  if (Source.Width = 0) or (Source.Height = 0) then Exit;
-
 
3640
 
-
 
3641
  if AsSigned(D2D) and D2D.CanUseD2D and (D2D.FDDraw.Surface = Self) then begin
-
 
3642
    D2D.D2DRenderRotateDDS(Source, SrcRect, X, Y, Width, Height, rtDraw, CenterX, CenterY, Angle, $FF, Transparent);
-
 
3643
    Exit;
-
 
3644
  end;
-
 
3645
  {$IFDEF DXR_deprecated}
-
 
3646
  if dxrDDSurfaceLock({$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, DestSurface) then
2000
  begin
3647
  begin
2001
    try
3648
    try
2002
      if dxrDDSurfaceLock2(Source.ISurface, Src_ddsd, SrcSurface) then
3649
      if dxrDDSurfaceLock2(Source.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, Src_ddsd, SrcSurface) then
2003
      begin
3650
      begin
2004
        try
3651
        try
2005
          dxrDrawRotateBlend(DestSurface, SrcSurface,
3652
          dxrDrawRotateBlend(DestSurface, SrcSurface,
2006
            X, Y, Width, Height, SrcRect, CenterX, CenterY, Angle, DXR_BLEND_ONE1, 0,
3653
            X, Y, Width, Height, SrcRect, CenterX, CenterY, round(Angle), DXR_BLEND_ONE1, 0,
2007
            Transparent, Src_ddsd.ddckCKSrcBlt.dwColorSpaceLowValue);
3654
            Transparent, Src_ddsd.ddckCKSrcBlt.dwColorSpaceLowValue);
2008
        finally
3655
        finally
2009
          dxrDDSurfaceUnLock(Source.ISurface, SrcSurface)
3656
          dxrDDSurfaceUnLock(Source.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, SrcSurface)
2010
        end;
3657
        end;
2011
      end;
3658
      end;
2012
    finally
3659
    finally
2013
      dxrDDSurfaceUnLock(ISurface, DestSurface)
3660
      dxrDDSurfaceUnLock({$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, DestSurface)
2014
    end;
3661
    end;
2015
  end;
3662
  end;
-
 
3663
  {$ENDIF}
2016
end;
3664
end;
2017
 
3665
 
2018
procedure TDirectDrawSurface.DrawRotateAdd(X, Y, Width, Height: Integer; const SrcRect: TRect;
3666
procedure TDirectDrawSurface.DrawRotateAdd(X, Y, Width, Height: Integer; const SrcRect: TRect;
2019
  Source: TDirectDrawSurface; CenterX, CenterY: Double; Transparent: Boolean; Angle, Alpha: Integer);
3667
  Source: TDirectDrawSurface; CenterX, CenterY: Double; Transparent: Boolean; Angle: single; Alpha: Integer);
2020
var
3668
{$IFDEF DXR_deprecated}var
2021
  Src_ddsd: TDDSurfaceDesc;
3669
  Src_ddsd: {$IFDEF D3D_deprecated}TDDSurfaceDesc{$ELSE}TDDSurfaceDesc2{$ENDIF};
2022
  DestSurface, SrcSurface: TDXR_Surface;
3670
  DestSurface, SrcSurface: TDXR_Surface;
2023
  Blend: TDXR_Blend;
3671
  Blend: TDXR_Blend; {$ENDIF}
2024
begin
3672
begin
2025
  if Alpha<=0 then Exit;
3673
  if Alpha <= 0 then Exit;
2026
 
3674
 
2027
  if (Self.Width=0) or (Self.Height=0) then Exit;
3675
  if (Self.Width = 0) or (Self.Height = 0) then Exit;
2028
  if (Width=0) or (Height=0) then Exit;
3676
  if (Width = 0) or (Height = 0) then Exit;
2029
  if Source=nil then Exit;
3677
  if Source = nil then Exit;
2030
  if (Source.Width=0) or (Source.Height=0) then Exit;
3678
  if (Source.Width = 0) or (Source.Height = 0) then Exit;
2031
 
3679
 
-
 
3680
  if AsSigned(D2D) and D2D.CanUseD2D and (D2D.FDDraw.Surface = Self) then begin
-
 
3681
    D2D.D2DRenderRotateDDS(Source, SrcRect, X, Y, Width, Height, rtAdd, CenterX, CenterY, Angle, Alpha, Transparent);
-
 
3682
    Exit;
-
 
3683
  end;
-
 
3684
  {$IFDEF DXR_deprecated}
2032
  if dxrDDSurfaceLock(ISurface, DestSurface) then
3685
  if dxrDDSurfaceLock({$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, DestSurface) then
2033
  begin
3686
  begin
2034
    try
3687
    try
2035
      if dxrDDSurfaceLock2(Source.ISurface, Src_ddsd, SrcSurface) then
3688
      if dxrDDSurfaceLock2(Source.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, Src_ddsd, SrcSurface) then
2036
      begin
3689
      begin
2037
        try
3690
        try
2038
          if DestSurface.ColorType=DXR_COLORTYPE_INDEXED then
3691
          if DestSurface.ColorType = DXR_COLORTYPE_INDEXED then
2039
          begin
3692
          begin
2040
            Blend := DXR_BLEND_ONE1;
3693
            Blend := DXR_BLEND_ONE1;
2041
          end else
3694
          end else
2042
          if Alpha>=255 then
3695
            if Alpha >= 255 then
2043
          begin
3696
            begin
2044
            Blend := DXR_BLEND_ONE1_ADD_ONE2;
3697
              Blend := DXR_BLEND_ONE1_ADD_ONE2;
2045
          end else
3698
            end else
2046
          begin
3699
            begin
2047
            Blend := DXR_BLEND_SRCALPHA1_ADD_ONE2;
3700
              Blend := DXR_BLEND_SRCALPHA1_ADD_ONE2;
2048
          end;
3701
            end;
2049
 
3702
 
2050
          dxrDrawRotateBlend(DestSurface, SrcSurface,
3703
          dxrDrawRotateBlend(DestSurface, SrcSurface,
2051
            X, Y, Width, Height, SrcRect, CenterX, CenterY, Angle, Blend, Alpha,
3704
            X, Y, Width, Height, SrcRect, CenterX, CenterY, round(Angle), Blend, Alpha,
2052
            Transparent, Src_ddsd.ddckCKSrcBlt.dwColorSpaceLowValue);
3705
            Transparent, Src_ddsd.ddckCKSrcBlt.dwColorSpaceLowValue);
2053
        finally
3706
        finally
2054
          dxrDDSurfaceUnLock(Source.ISurface, SrcSurface)
3707
          dxrDDSurfaceUnLock(Source.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, SrcSurface)
2055
        end;
3708
        end;
2056
      end;
3709
      end;
2057
    finally
3710
    finally
2058
      dxrDDSurfaceUnLock(ISurface, DestSurface)
3711
      dxrDDSurfaceUnLock({$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, DestSurface)
2059
    end;
3712
    end;
2060
  end;
3713
  end;
-
 
3714
  {$ENDIF}
2061
end;
3715
end;
2062
 
3716
 
2063
procedure TDirectDrawSurface.DrawRotateAlpha(X, Y, Width, Height: Integer; const SrcRect: TRect;
3717
procedure TDirectDrawSurface.DrawRotateAlpha(X, Y, Width, Height: Integer; const SrcRect: TRect;
2064
  Source: TDirectDrawSurface; CenterX, CenterY: Double; Transparent: Boolean; Angle, Alpha: Integer);
3718
  Source: TDirectDrawSurface; CenterX, CenterY: Double; Transparent: Boolean; Angle: single; Alpha: Integer);
2065
var
3719
{$IFDEF DXR_deprecated}var
2066
  Src_ddsd: TDDSurfaceDesc;
3720
  Src_ddsd: {$IFDEF D3D_deprecated}TDDSurfaceDesc{$ELSE}TDDSurfaceDesc2{$ENDIF};
2067
  DestSurface, SrcSurface: TDXR_Surface;
3721
  DestSurface, SrcSurface: TDXR_Surface;
2068
  Blend: TDXR_Blend;
3722
  Blend: TDXR_Blend; {$ENDIF}
2069
begin
3723
begin
2070
  if Alpha<=0 then Exit;
3724
  if Alpha <= 0 then Exit;
2071
 
3725
 
2072
  if (Self.Width=0) or (Self.Height=0) then Exit;
3726
  if (Self.Width = 0) or (Self.Height = 0) then Exit;
2073
  if (Width=0) or (Height=0) then Exit;
3727
  if (Width = 0) or (Height = 0) then Exit;
2074
  if Source=nil then Exit;
3728
  if Source = nil then Exit;
2075
  if (Source.Width=0) or (Source.Height=0) then Exit;
3729
  if (Source.Width = 0) or (Source.Height = 0) then Exit;
2076
 
3730
 
-
 
3731
  if AsSigned(D2D) and D2D.CanUseD2D and (D2D.FDDraw.Surface = Self) then begin
-
 
3732
    D2D.D2DRenderRotateDDS(Source, SrcRect, X, Y, Width, Height, rtBlend, CenterX, CenterY, Angle, Alpha, Transparent);
-
 
3733
    Exit;
-
 
3734
  end;
-
 
3735
  {$IFDEF DXR_deprecated}
2077
  if dxrDDSurfaceLock(ISurface, DestSurface) then
3736
  if dxrDDSurfaceLock({$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, DestSurface) then
2078
  begin
3737
  begin
2079
    try
3738
    try
2080
      if dxrDDSurfaceLock2(Source.ISurface, Src_ddsd, SrcSurface) then
3739
      if dxrDDSurfaceLock2(Source.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, Src_ddsd, SrcSurface) then
2081
      begin
3740
      begin
2082
        try
3741
        try
2083
          if DestSurface.ColorType=DXR_COLORTYPE_INDEXED then
3742
          if DestSurface.ColorType = DXR_COLORTYPE_INDEXED then
2084
          begin
3743
          begin
2085
            Blend := DXR_BLEND_ONE1;
3744
            Blend := DXR_BLEND_ONE1;
2086
          end else
3745
          end else
2087
          if Alpha>=255 then
3746
            if Alpha >= 255 then
2088
          begin
3747
            begin
2089
            Blend := DXR_BLEND_ONE1;
3748
              Blend := DXR_BLEND_ONE1;
2090
          end else
3749
            end else
2091
          begin
3750
            begin
2092
            Blend := DXR_BLEND_SRCALPHA1_ADD_INVSRCALPHA2;
3751
              Blend := DXR_BLEND_SRCALPHA1_ADD_INVSRCALPHA2;
2093
          end;
3752
            end;
2094
 
3753
 
2095
          dxrDrawRotateBlend(DestSurface, SrcSurface,
3754
          dxrDrawRotateBlend(DestSurface, SrcSurface,
2096
            X, Y, Width, Height, SrcRect, CenterX, CenterY, Angle, Blend, Alpha,
3755
            X, Y, Width, Height, SrcRect, CenterX, CenterY, round(Angle), Blend, Alpha,
2097
            Transparent, Src_ddsd.ddckCKSrcBlt.dwColorSpaceLowValue);
3756
            Transparent, Src_ddsd.ddckCKSrcBlt.dwColorSpaceLowValue);
2098
        finally
3757
        finally
2099
          dxrDDSurfaceUnLock(Source.ISurface, SrcSurface)
3758
          dxrDDSurfaceUnLock(Source.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, SrcSurface)
2100
        end;
3759
        end;
2101
      end;
3760
      end;
2102
    finally
3761
    finally
2103
      dxrDDSurfaceUnLock(ISurface, DestSurface)
3762
      dxrDDSurfaceUnLock({$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, DestSurface)
2104
    end;
3763
    end;
2105
  end;
3764
  end;
-
 
3765
  {$ENDIF}
2106
end;
3766
end;
2107
 
3767
 
2108
procedure TDirectDrawSurface.DrawRotateSub(X, Y, Width, Height: Integer; const SrcRect: TRect;
3768
procedure TDirectDrawSurface.DrawRotateSub(X, Y, Width, Height: Integer; const SrcRect: TRect;
2109
  Source: TDirectDrawSurface; CenterX, CenterY: Double; Transparent: Boolean; Angle, Alpha: Integer);
3769
  Source: TDirectDrawSurface; CenterX, CenterY: Double; Transparent: Boolean; Angle: single; Alpha: Integer);
2110
var
3770
{$IFDEF DXR_deprecated}var
2111
  Src_ddsd: TDDSurfaceDesc;
3771
  Src_ddsd: {$IFDEF D3D_deprecated}TDDSurfaceDesc{$ELSE}TDDSurfaceDesc2{$ENDIF};
2112
  DestSurface, SrcSurface: TDXR_Surface;
3772
  DestSurface, SrcSurface: TDXR_Surface;
2113
  Blend: TDXR_Blend;
3773
  Blend: TDXR_Blend;{$ENDIF}
2114
begin
3774
begin
2115
  if Alpha<=0 then Exit;
3775
  if Alpha <= 0 then Exit;
2116
 
3776
 
2117
  if (Self.Width=0) or (Self.Height=0) then Exit;
3777
  if (Self.Width = 0) or (Self.Height = 0) then Exit;
2118
  if (Width=0) or (Height=0) then Exit;
3778
  if (Width = 0) or (Height = 0) then Exit;
2119
  if Source=nil then Exit;
3779
  if Source = nil then Exit;
2120
  if (Source.Width=0) or (Source.Height=0) then Exit;
3780
  if (Source.Width = 0) or (Source.Height = 0) then Exit;
2121
 
3781
 
-
 
3782
  if AsSigned(D2D) and D2D.CanUseD2D and (D2D.FDDraw.Surface = Self) then begin
-
 
3783
    D2D.D2DRenderRotateDDS(Source, SrcRect, X, Y, Width, Height, rtSub, CenterX, CenterY, Angle, Alpha, Transparent);
-
 
3784
    Exit;
-
 
3785
  end;
-
 
3786
  {$IFDEF DXR_deprecated}
2122
  if dxrDDSurfaceLock(ISurface, DestSurface) then
3787
  if dxrDDSurfaceLock({$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, DestSurface) then
2123
  begin
3788
  begin
2124
    try
3789
    try
2125
      if dxrDDSurfaceLock2(Source.ISurface, Src_ddsd, SrcSurface) then
3790
      if dxrDDSurfaceLock2(Source.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, Src_ddsd, SrcSurface) then
2126
      begin
3791
      begin
2127
        try
3792
        try
2128
          if DestSurface.ColorType=DXR_COLORTYPE_INDEXED then
3793
          if DestSurface.ColorType = DXR_COLORTYPE_INDEXED then
2129
          begin
3794
          begin
2130
            Blend := DXR_BLEND_ONE1;
3795
            Blend := DXR_BLEND_ONE1;
2131
          end else
3796
          end else
2132
          if Alpha>=255 then
3797
            if Alpha >= 255 then
2133
          begin
3798
            begin
2134
            Blend := DXR_BLEND_ONE2_SUB_ONE1;
3799
              Blend := DXR_BLEND_ONE2_SUB_ONE1;
2135
          end else
3800
            end else
2136
          begin
3801
            begin
2137
            Blend := DXR_BLEND_ONE2_SUB_SRCALPHA1;
3802
              Blend := DXR_BLEND_ONE2_SUB_SRCALPHA1;
2138
          end;
3803
            end;
2139
 
3804
 
2140
          dxrDrawRotateBlend(DestSurface, SrcSurface,
3805
          dxrDrawRotateBlend(DestSurface, SrcSurface,
2141
            X, Y, Width, Height, SrcRect, CenterX, CenterY, Angle, Blend, Alpha,
3806
            X, Y, Width, Height, SrcRect, CenterX, CenterY, round(Angle), Blend, Alpha,
2142
            Transparent, Src_ddsd.ddckCKSrcBlt.dwColorSpaceLowValue);
3807
            Transparent, Src_ddsd.ddckCKSrcBlt.dwColorSpaceLowValue);
2143
        finally
3808
        finally
2144
          dxrDDSurfaceUnLock(Source.ISurface, SrcSurface)
3809
          dxrDDSurfaceUnLock(Source.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, SrcSurface)
2145
        end;
3810
        end;
2146
      end;
3811
      end;
2147
    finally
3812
    finally
2148
      dxrDDSurfaceUnLock(ISurface, DestSurface)
3813
      dxrDDSurfaceUnLock({$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, DestSurface)
2149
    end;
3814
    end;
2150
  end;
3815
  end;
-
 
3816
  {$ENDIF}
2151
end;
3817
end;
2152
 
3818
 
-
 
3819
procedure TDirectDrawSurface.DrawRotateCol(X, Y, Width, Height: Integer; const SrcRect: TRect;
-
 
3820
  Source: TDirectDrawSurface; CenterX, CenterY: Double; Transparent: Boolean; Angle: Single; Color: Integer);
-
 
3821
begin
-
 
3822
  if (Self.Width = 0) or (Self.Height = 0) then Exit;
-
 
3823
  if (Width = 0) or (Height = 0) then Exit;
-
 
3824
  if Source = nil then Exit;
-
 
3825
  if (Source.Width = 0) or (Source.Height = 0) then Exit;
-
 
3826
 
-
 
3827
  if AsSigned(D2D) and D2D.CanUseD2D and (D2D.FDDraw.Surface = Self) then begin
-
 
3828
    D2D.D2DRenderRotateModeColDDS(Source, X, Y, Width, Height, rtDraw, CenterX, CenterY, Angle, Color, $FF, Transparent);
-
 
3829
    Exit;
-
 
3830
  end;
-
 
3831
 
-
 
3832
  // If no hardware acceleration, falls back to non-color, moded DrawRotate
-
 
3833
  Self.DrawRotate(X, Y, Width, Height, SrcRect, Source, CenterX, CenterY, Transparent, Angle);
-
 
3834
end;
-
 
3835
 
-
 
3836
procedure TDirectDrawSurface.DrawRotateAlphaCol(X, Y, Width, Height: Integer; const SrcRect: TRect;
-
 
3837
  Source: TDirectDrawSurface; CenterX, CenterY: Double; Transparent: Boolean; Angle: Single; Color, Alpha: Integer);
-
 
3838
begin
-
 
3839
  if (Self.Width = 0) or (Self.Height = 0) then Exit;
-
 
3840
  if (Width = 0) or (Height = 0) then Exit;
-
 
3841
  if Source = nil then Exit;
-
 
3842
  if (Source.Width = 0) or (Source.Height = 0) then Exit;
-
 
3843
 
-
 
3844
  if AsSigned(D2D) and D2D.CanUseD2D and (D2D.FDDraw.Surface = Self) then begin
-
 
3845
    D2D.D2DRenderRotateModeColDDS(Source, X, Y, Width, Height, rtBlend, CenterX, CenterY, Angle, Color, Alpha, Transparent);
-
 
3846
    Exit;
-
 
3847
  end;
-
 
3848
 
-
 
3849
  // If no hardware acceleration, falls back to non-color, moded DrawRotate
-
 
3850
  Self.DrawRotateAlpha(X, Y, Width, Height, SrcRect, Source, CenterX, CenterY, Transparent, Angle, Alpha);
-
 
3851
end;
-
 
3852
 
-
 
3853
procedure TDirectDrawSurface.DrawRotateAddCol(X, Y, Width, Height: Integer; const SrcRect: TRect;
-
 
3854
  Source: TDirectDrawSurface; CenterX, CenterY: Double; Transparent: Boolean; Angle: Single; Color, Alpha: Integer);
-
 
3855
begin
-
 
3856
  if (Self.Width = 0) or (Self.Height = 0) then Exit;
-
 
3857
  if (Width = 0) or (Height = 0) then Exit;
-
 
3858
  if Source = nil then Exit;
-
 
3859
  if (Source.Width = 0) or (Source.Height = 0) then Exit;
-
 
3860
 
-
 
3861
  if AsSigned(D2D) and D2D.CanUseD2D and (D2D.FDDraw.Surface = Self) then begin
-
 
3862
    D2D.D2DRenderRotateModeColDDS(Source, X, Y, Width, Height, rtAdd, CenterX, CenterY, Angle, Color, Alpha, Transparent);
-
 
3863
    Exit;
-
 
3864
  end;
-
 
3865
 
-
 
3866
  // If no hardware acceleration, falls back to non-color, moded DrawRotate
-
 
3867
  Self.DrawRotateAdd(X, Y, Width, Height, SrcRect, Source, CenterX, CenterY, Transparent, Angle, Alpha);
-
 
3868
end;
-
 
3869
 
-
 
3870
procedure TDirectDrawSurface.DrawRotateSubCol(X, Y, Width, Height: Integer; const SrcRect: TRect;
-
 
3871
  Source: TDirectDrawSurface; CenterX, CenterY: Double; Transparent: Boolean; Angle: Single; Color, Alpha: Integer);
-
 
3872
begin
-
 
3873
  if (Self.Width = 0) or (Self.Height = 0) then Exit;
-
 
3874
  if (Width = 0) or (Height = 0) then Exit;
-
 
3875
  if Source = nil then Exit;
-
 
3876
  if (Source.Width = 0) or (Source.Height = 0) then Exit;
-
 
3877
 
-
 
3878
  if AsSigned(D2D) and D2D.CanUseD2D and (D2D.FDDraw.Surface = Self) then begin
-
 
3879
    D2D.D2DRenderRotateModeColDDS(Source, X, Y, Width, Height, rtSub, CenterX, CenterY, Angle, Color, Alpha, Transparent);
-
 
3880
    Exit;
-
 
3881
  end;
-
 
3882
 
-
 
3883
  // If no hardware acceleration, falls back to non-color, moded DrawRotate
-
 
3884
  Self.DrawRotateSub(X, Y, Width, Height, SrcRect, Source, CenterX, CenterY, Transparent, Angle, Alpha);
-
 
3885
end;
-
 
3886
 
-
 
3887
//waves
-
 
3888
 
2153
procedure TDirectDrawSurface.DrawWaveX(X, Y, Width, Height: Integer; const SrcRect: TRect;
3889
procedure TDirectDrawSurface.DrawWaveX(X, Y, Width, Height: Integer; const SrcRect: TRect;
2154
  Source: TDirectDrawSurface; Transparent: Boolean; amp, Len, ph: Integer);
3890
  Source: TDirectDrawSurface; Transparent: Boolean; amp, Len, ph: Integer);
2155
var
3891
{$IFDEF DXR_deprecated}var
2156
  Src_ddsd: TDDSurfaceDesc;
3892
  Src_ddsd: {$IFDEF D3D_deprecated}TDDSurfaceDesc{$ELSE}TDDSurfaceDesc2{$ENDIF};
2157
  DestSurface, SrcSurface: TDXR_Surface;
3893
  DestSurface, SrcSurface: TDXR_Surface;{$ENDIF}
2158
begin
3894
begin
2159
  if (Self.Width=0) or (Self.Height=0) then Exit;
3895
  if (Self.Width = 0) or (Self.Height = 0) then Exit;
2160
  if (Width=0) or (Height=0) then Exit;
3896
  if (Width = 0) or (Height = 0) then Exit;
2161
  if Source=nil then Exit;
3897
  if Source = nil then Exit;
2162
  if (Source.Width=0) or (Source.Height=0) then Exit;
3898
  if (Source.Width = 0) or (Source.Height = 0) then Exit;
2163
 
3899
 
-
 
3900
  if AsSigned(D2D) and D2D.CanUseD2D and (D2D.FDDraw.Surface = Self) then begin
-
 
3901
    D2D.D2DRenderWaveXDDS(Source, X, Y, Width, Height, rtDraw, Transparent, amp, Len, ph{$IFNDEF VER4UP}, $FF{$ENDIF});
-
 
3902
    Exit;
-
 
3903
  end;
-
 
3904
  {$IFDEF DXR_deprecated}
2164
  if dxrDDSurfaceLock(ISurface, DestSurface) then
3905
  if dxrDDSurfaceLock({$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, DestSurface) then
2165
  begin
3906
  begin
2166
    try
3907
    try
2167
      if dxrDDSurfaceLock2(Source.ISurface, Src_ddsd, SrcSurface) then
3908
      if dxrDDSurfaceLock2(Source.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, Src_ddsd, SrcSurface) then
2168
      begin
3909
      begin
2169
        try
3910
        try
2170
          dxrDrawWaveXBlend(DestSurface, SrcSurface,
3911
          dxrDrawWaveXBlend(DestSurface, SrcSurface,
2171
            X, Y, Width, Height, SrcRect, amp, Len, ph, DXR_BLEND_ONE1, 0,
3912
            X, Y, Width, Height, SrcRect, amp, Len, ph, DXR_BLEND_ONE1, 0,
2172
            Transparent, Src_ddsd.ddckCKSrcBlt.dwColorSpaceLowValue);
3913
            Transparent, Src_ddsd.ddckCKSrcBlt.dwColorSpaceLowValue);
2173
        finally
3914
        finally
2174
          dxrDDSurfaceUnLock(Source.ISurface, SrcSurface)
3915
          dxrDDSurfaceUnLock(Source.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, SrcSurface)
2175
        end;
3916
        end;
2176
      end;
3917
      end;
2177
    finally
3918
    finally
2178
      dxrDDSurfaceUnLock(ISurface, DestSurface)
3919
      dxrDDSurfaceUnLock({$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, DestSurface)
2179
    end;
3920
    end;
2180
  end;
3921
  end;
-
 
3922
  {$ENDIF}
2181
end;
3923
end;
2182
 
3924
 
2183
procedure TDirectDrawSurface.DrawWaveXAdd(X, Y, Width, Height: Integer; const SrcRect: TRect;
3925
procedure TDirectDrawSurface.DrawWaveXAdd(X, Y, Width, Height: Integer; const SrcRect: TRect;
2184
  Source: TDirectDrawSurface; Transparent: Boolean; amp, Len, ph, Alpha: Integer);
3926
  Source: TDirectDrawSurface; Transparent: Boolean; amp, Len, ph, Alpha: Integer);
2185
var
3927
{$IFDEF DXR_deprecated}var
2186
  Src_ddsd: TDDSurfaceDesc;
3928
  Src_ddsd: {$IFDEF D3D_deprecated}TDDSurfaceDesc{$ELSE}TDDSurfaceDesc2{$ENDIF};
2187
  DestSurface, SrcSurface: TDXR_Surface;
3929
  DestSurface, SrcSurface: TDXR_Surface;
2188
  Blend: TDXR_Blend;
3930
  Blend: TDXR_Blend;{$ENDIF}
2189
begin
3931
begin
2190
  if Alpha<=0 then Exit;
3932
  if Alpha <= 0 then Exit;
2191
 
3933
 
2192
  if (Self.Width=0) or (Self.Height=0) then Exit;
3934
  if (Self.Width = 0) or (Self.Height = 0) then Exit;
2193
  if (Width=0) or (Height=0) then Exit;
3935
  if (Width = 0) or (Height = 0) then Exit;
2194
  if Source=nil then Exit;
3936
  if Source = nil then Exit;
2195
  if (Source.Width=0) or (Source.Height=0) then Exit;
3937
  if (Source.Width = 0) or (Source.Height = 0) then Exit;
2196
 
3938
 
-
 
3939
  if AsSigned(D2D) and D2D.CanUseD2D and (D2D.FDDraw.Surface = Self) then begin
-
 
3940
    D2D.D2DRenderWaveXDDS(Source, X, Y, Width, Height, rtAdd, Transparent, amp, Len, ph, Alpha);
-
 
3941
    Exit;
-
 
3942
  end;
-
 
3943
  {$IFDEF DXR_deprecated}
2197
  if dxrDDSurfaceLock(ISurface, DestSurface) then
3944
  if dxrDDSurfaceLock({$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, DestSurface) then
2198
  begin
3945
  begin
2199
    try
3946
    try
2200
      if dxrDDSurfaceLock2(Source.ISurface, Src_ddsd, SrcSurface) then
3947
      if dxrDDSurfaceLock2(Source.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, Src_ddsd, SrcSurface) then
2201
      begin
3948
      begin
2202
        try
3949
        try
2203
          if DestSurface.ColorType=DXR_COLORTYPE_INDEXED then
3950
          if DestSurface.ColorType = DXR_COLORTYPE_INDEXED then
2204
          begin
3951
          begin
2205
            Blend := DXR_BLEND_ONE1;
3952
            Blend := DXR_BLEND_ONE1;
2206
          end else
3953
          end else
2207
          if Alpha>=255 then
3954
            if Alpha >= 255 then
2208
          begin
3955
            begin
2209
            Blend := DXR_BLEND_ONE1_ADD_ONE2;
3956
              Blend := DXR_BLEND_ONE1_ADD_ONE2;
2210
          end else
3957
            end else
2211
          begin
3958
            begin
2212
            Blend := DXR_BLEND_SRCALPHA1_ADD_ONE2;
3959
              Blend := DXR_BLEND_SRCALPHA1_ADD_ONE2;
2213
          end;
3960
            end;
2214
 
3961
 
2215
          dxrDrawWaveXBlend(DestSurface, SrcSurface,
3962
          dxrDrawWaveXBlend(DestSurface, SrcSurface,
2216
            X, Y, Width, Height, SrcRect, amp, Len, ph, Blend, Alpha,
3963
            X, Y, Width, Height, SrcRect, amp, Len, ph, Blend, Alpha,
2217
            Transparent, Src_ddsd.ddckCKSrcBlt.dwColorSpaceLowValue);
3964
            Transparent, Src_ddsd.ddckCKSrcBlt.dwColorSpaceLowValue);
2218
        finally
3965
        finally
2219
          dxrDDSurfaceUnLock(Source.ISurface, SrcSurface)
3966
          dxrDDSurfaceUnLock(Source.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, SrcSurface)
2220
        end;
3967
        end;
2221
      end;
3968
      end;
2222
    finally
3969
    finally
2223
      dxrDDSurfaceUnLock(ISurface, DestSurface)
3970
      dxrDDSurfaceUnLock({$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, DestSurface)
2224
    end;
3971
    end;
2225
  end;
3972
  end;
-
 
3973
  {$ENDIF}
2226
end;
3974
end;
2227
 
3975
 
2228
procedure TDirectDrawSurface.DrawWaveXAlpha(X, Y, Width, Height: Integer; const SrcRect: TRect;
3976
procedure TDirectDrawSurface.DrawWaveXAlpha(X, Y, Width, Height: Integer; const SrcRect: TRect;
2229
  Source: TDirectDrawSurface; Transparent: Boolean; amp, Len, ph, Alpha: Integer);
3977
  Source: TDirectDrawSurface; Transparent: Boolean; amp, Len, ph, Alpha: Integer);
-
 
3978
{$IFDEF DXR_deprecated}
2230
var
3979
var
2231
  Src_ddsd: TDDSurfaceDesc;
3980
  Src_ddsd: {$IFDEF D3D_deprecated}TDDSurfaceDesc{$ELSE}TDDSurfaceDesc2{$ENDIF};
2232
  DestSurface, SrcSurface: TDXR_Surface;
3981
  DestSurface, SrcSurface: TDXR_Surface;
2233
  Blend: TDXR_Blend;
3982
  Blend: TDXR_Blend;{$ENDIF}
2234
begin
3983
begin
2235
  if Alpha<=0 then Exit;
3984
  if Alpha <= 0 then Exit;
2236
 
3985
 
2237
  if (Self.Width=0) or (Self.Height=0) then Exit;
3986
  if (Self.Width = 0) or (Self.Height = 0) then Exit;
2238
  if (Width=0) or (Height=0) then Exit;
3987
  if (Width = 0) or (Height = 0) then Exit;
2239
  if Source=nil then Exit;
3988
  if Source = nil then Exit;
2240
  if (Source.Width=0) or (Source.Height=0) then Exit;
3989
  if (Source.Width = 0) or (Source.Height = 0) then Exit;
2241
 
3990
 
-
 
3991
  if AsSigned(D2D) and D2D.CanUseD2D and (D2D.FDDraw.Surface = Self) then begin
-
 
3992
    D2D.D2DRenderWaveXDDS(Source, X, Y, Width, Height, rtBlend, Transparent, amp, Len, ph, Alpha);
-
 
3993
    Exit;
-
 
3994
  end;
-
 
3995
  {$IFDEF DXR_deprecated}
2242
  if dxrDDSurfaceLock(ISurface, DestSurface) then
3996
  if dxrDDSurfaceLock({$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, DestSurface) then
2243
  begin
3997
  begin
2244
    try
3998
    try
2245
      if dxrDDSurfaceLock2(Source.ISurface, Src_ddsd, SrcSurface) then
3999
      if dxrDDSurfaceLock2(Source.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, Src_ddsd, SrcSurface) then
2246
      begin
4000
      begin
2247
        try
4001
        try
2248
          if DestSurface.ColorType=DXR_COLORTYPE_INDEXED then
4002
          if DestSurface.ColorType = DXR_COLORTYPE_INDEXED then
2249
          begin
4003
          begin
2250
            Blend := DXR_BLEND_ONE1;
4004
            Blend := DXR_BLEND_ONE1;
2251
          end else
4005
          end else
2252
          if Alpha>=255 then
4006
            if Alpha >= 255 then
2253
          begin
4007
            begin
2254
            Blend := DXR_BLEND_ONE1;
4008
              Blend := DXR_BLEND_ONE1;
2255
          end else
4009
            end else
2256
          begin
4010
            begin
2257
            Blend := DXR_BLEND_SRCALPHA1_ADD_INVSRCALPHA2;
4011
              Blend := DXR_BLEND_SRCALPHA1_ADD_INVSRCALPHA2;
2258
          end;
4012
            end;
2259
 
4013
 
2260
          dxrDrawWaveXBlend(DestSurface, SrcSurface,
4014
          dxrDrawWaveXBlend(DestSurface, SrcSurface,
2261
            X, Y, Width, Height, SrcRect, amp, Len, ph, Blend, Alpha,
4015
            X, Y, Width, Height, SrcRect, amp, Len, ph, Blend, Alpha,
2262
            Transparent, Src_ddsd.ddckCKSrcBlt.dwColorSpaceLowValue);
4016
            Transparent, Src_ddsd.ddckCKSrcBlt.dwColorSpaceLowValue);
2263
        finally
4017
        finally
2264
          dxrDDSurfaceUnLock(Source.ISurface, SrcSurface)
4018
          dxrDDSurfaceUnLock(Source.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, SrcSurface)
2265
        end;
4019
        end;
2266
      end;
4020
      end;
2267
    finally
4021
    finally
2268
      dxrDDSurfaceUnLock(ISurface, DestSurface)
4022
      dxrDDSurfaceUnLock({$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, DestSurface)
2269
    end;
4023
    end;
2270
  end;
4024
  end;
-
 
4025
  {$ENDIF}
2271
end;
4026
end;
2272
 
4027
 
2273
procedure TDirectDrawSurface.DrawWaveXSub(X, Y, Width, Height: Integer; const SrcRect: TRect;
4028
procedure TDirectDrawSurface.DrawWaveXSub(X, Y, Width, Height: Integer; const SrcRect: TRect;
2274
  Source: TDirectDrawSurface; Transparent: Boolean; amp, Len, ph, Alpha: Integer);
4029
  Source: TDirectDrawSurface; Transparent: Boolean; amp, Len, ph, Alpha: Integer);
-
 
4030
{$IFDEF DXR_deprecated}
2275
var
4031
var
2276
  Src_ddsd: TDDSurfaceDesc;
4032
  Src_ddsd: {$IFDEF D3D_deprecated}TDDSurfaceDesc{$ELSE}TDDSurfaceDesc2{$ENDIF};
2277
  DestSurface, SrcSurface: TDXR_Surface;
4033
  DestSurface, SrcSurface: TDXR_Surface;
2278
  Blend: TDXR_Blend;
4034
  Blend: TDXR_Blend;{$ENDIF}
2279
begin
4035
begin
2280
  if Alpha<=0 then Exit;
4036
  if Alpha <= 0 then Exit;
2281
 
4037
 
2282
  if (Self.Width=0) or (Self.Height=0) then Exit;
4038
  if (Self.Width = 0) or (Self.Height = 0) then Exit;
2283
  if (Width=0) or (Height=0) then Exit;
4039
  if (Width = 0) or (Height = 0) then Exit;
2284
  if Source=nil then Exit;
4040
  if Source = nil then Exit;
2285
  if (Source.Width=0) or (Source.Height=0) then Exit;
4041
  if (Source.Width = 0) or (Source.Height = 0) then Exit;
2286
 
4042
 
-
 
4043
  if AsSigned(D2D) and D2D.CanUseD2D and (D2D.FDDraw.Surface = Self) then begin
-
 
4044
    D2D.D2DRenderWaveXDDS(Source, X, Y, Width, Height, rtSub, Transparent, amp, Len, ph, Alpha);
-
 
4045
    Exit;
-
 
4046
  end;
-
 
4047
  {$IFDEF DXR_deprecated}
2287
  if dxrDDSurfaceLock(ISurface, DestSurface) then
4048
  if dxrDDSurfaceLock({$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, DestSurface) then
2288
  begin
4049
  begin
2289
    try
4050
    try
2290
      if dxrDDSurfaceLock2(Source.ISurface, Src_ddsd, SrcSurface) then
4051
      if dxrDDSurfaceLock2(Source.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, Src_ddsd, SrcSurface) then
2291
      begin
4052
      begin
2292
        try
4053
        try
2293
          if DestSurface.ColorType=DXR_COLORTYPE_INDEXED then
4054
          if DestSurface.ColorType = DXR_COLORTYPE_INDEXED then
2294
          begin
4055
          begin
2295
            Blend := DXR_BLEND_ONE1;
4056
            Blend := DXR_BLEND_ONE1;
2296
          end else
4057
          end else
2297
          if Alpha>=255 then
4058
            if Alpha >= 255 then
2298
          begin    
4059
            begin
2299
            Blend := DXR_BLEND_ONE2_SUB_ONE1;
4060
              Blend := DXR_BLEND_ONE2_SUB_ONE1;
2300
          end else
4061
            end else
2301
          begin
4062
            begin
2302
            Blend := DXR_BLEND_ONE2_SUB_SRCALPHA1;
4063
              Blend := DXR_BLEND_ONE2_SUB_SRCALPHA1;
2303
          end;
4064
            end;
2304
 
4065
 
2305
          dxrDrawWaveXBlend(DestSurface, SrcSurface,
4066
          dxrDrawWaveXBlend(DestSurface, SrcSurface,
2306
            X, Y, Width, Height, SrcRect, amp, Len, ph, Blend, Alpha,
4067
            X, Y, Width, Height, SrcRect, amp, Len, ph, Blend, Alpha,
2307
            Transparent, Src_ddsd.ddckCKSrcBlt.dwColorSpaceLowValue);
4068
            Transparent, Src_ddsd.ddckCKSrcBlt.dwColorSpaceLowValue);
2308
        finally
4069
        finally
2309
          dxrDDSurfaceUnLock(Source.ISurface, SrcSurface)
4070
          dxrDDSurfaceUnLock(Source.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, SrcSurface)
2310
        end;
4071
        end;
2311
      end;
4072
      end;
2312
    finally
4073
    finally
2313
      dxrDDSurfaceUnLock(ISurface, DestSurface)
4074
      dxrDDSurfaceUnLock({$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, DestSurface)
2314
    end;
4075
    end;
2315
  end;
4076
  end;
-
 
4077
  {$ENDIF}
-
 
4078
end;
-
 
4079
 
-
 
4080
procedure TDirectDrawSurface.DrawWaveYSub(X, Y, Width, Height: Integer;
-
 
4081
  const SrcRect: TRect; Source: TDirectDrawSurface; Transparent: Boolean; amp,
-
 
4082
  Len, ph, Alpha: Integer);
-
 
4083
begin
-
 
4084
  if Alpha <= 0 then Exit;
-
 
4085
 
-
 
4086
  if (Self.Width = 0) or (Self.Height = 0) then Exit;
-
 
4087
  if (Width = 0) or (Height = 0) then Exit;
-
 
4088
  if Source = nil then Exit;
-
 
4089
  if (Source.Width = 0) or (Source.Height = 0) then Exit;
-
 
4090
 
-
 
4091
  if AsSigned(D2D) and D2D.CanUseD2D and (D2D.FDDraw.Surface = Self) then begin
-
 
4092
    D2D.D2DRenderWaveYDDS(Source, X, Y, Width, Height, rtSub, Transparent, amp, Len, ph, Alpha);
-
 
4093
    Exit;
-
 
4094
  end;
-
 
4095
end;
-
 
4096
 
-
 
4097
procedure TDirectDrawSurface.DrawWaveY(X, Y, Width, Height: Integer;
-
 
4098
  const SrcRect: TRect; Source: TDirectDrawSurface; Transparent: Boolean; amp,
-
 
4099
  Len, ph: Integer);
-
 
4100
begin
-
 
4101
  if (Self.Width = 0) or (Self.Height = 0) then Exit;
-
 
4102
  if (Width = 0) or (Height = 0) then Exit;
-
 
4103
  if Source = nil then Exit;
-
 
4104
  if (Source.Width = 0) or (Source.Height = 0) then Exit;
-
 
4105
 
-
 
4106
  if AsSigned(D2D) and D2D.CanUseD2D and (D2D.FDDraw.Surface = Self) then begin
-
 
4107
    D2D.D2DRenderWaveYDDS(Source, X, Y, Width, Height, rtDraw, Transparent, amp, Len, ph{$IFNDEF VER4UP}, $FF{$ENDIF});
-
 
4108
    Exit;
-
 
4109
  end;
-
 
4110
end;
-
 
4111
 
-
 
4112
procedure TDirectDrawSurface.DrawWaveYAdd(X, Y, Width, Height: Integer;
-
 
4113
  const SrcRect: TRect; Source: TDirectDrawSurface; Transparent: Boolean; amp,
-
 
4114
  Len, ph, Alpha: Integer);
-
 
4115
begin
-
 
4116
  if Alpha <= 0 then Exit;
-
 
4117
 
-
 
4118
  if (Self.Width = 0) or (Self.Height = 0) then Exit;
-
 
4119
  if (Width = 0) or (Height = 0) then Exit;
-
 
4120
  if Source = nil then Exit;
-
 
4121
  if (Source.Width = 0) or (Source.Height = 0) then Exit;
-
 
4122
 
-
 
4123
  if AsSigned(D2D) and D2D.CanUseD2D and (D2D.FDDraw.Surface = Self) then begin
-
 
4124
    D2D.D2DRenderWaveYDDS(Source, X, Y, Width, Height, rtAdd, Transparent, amp, Len, ph, Alpha);
-
 
4125
    Exit;
-
 
4126
  end;
-
 
4127
end;
-
 
4128
 
-
 
4129
procedure TDirectDrawSurface.DrawWaveYAlpha(X, Y, Width, Height: Integer;
-
 
4130
  const SrcRect: TRect; Source: TDirectDrawSurface; Transparent: Boolean; amp,
-
 
4131
  Len, ph, Alpha: Integer);
-
 
4132
begin
-
 
4133
  if Alpha <= 0 then Exit;
-
 
4134
 
-
 
4135
  if (Self.Width = 0) or (Self.Height = 0) then Exit;
-
 
4136
  if (Width = 0) or (Height = 0) then Exit;
-
 
4137
  if Source = nil then Exit;
-
 
4138
  if (Source.Width = 0) or (Source.Height = 0) then Exit;
-
 
4139
 
-
 
4140
  if AsSigned(D2D) and D2D.CanUseD2D and (D2D.FDDraw.Surface = Self) then begin
-
 
4141
    D2D.D2DRenderWaveYDDS(Source, X, Y, Width, Height, rtBlend, Transparent, amp, Len, ph, Alpha);
-
 
4142
    Exit;
-
 
4143
  end;
2316
end;
4144
end;
2317
 
4145
 
2318
procedure TDirectDrawSurface.Fill(DevColor: Longint);
4146
procedure TDirectDrawSurface.Fill(DevColor: Longint);
2319
var
4147
var
2320
  DBltEx: TDDBltFX;
4148
  DBltEx: TDDBltFX;
Line 2334... Line 4162...
2334
  DestRect := Rect;
4162
  DestRect := Rect;
2335
  if ClipRect(DestRect, ClientRect) then
4163
  if ClipRect(DestRect, ClientRect) then
2336
    Blt(DestRect, TRect(nil^), DDBLT_COLORFILL or DDBLT_WAIT, DBltEx, nil);
4164
    Blt(DestRect, TRect(nil^), DDBLT_COLORFILL or DDBLT_WAIT, DBltEx, nil);
2337
end;
4165
end;
2338
 
4166
 
2339
procedure TDirectDrawSurface.FillRectAdd(const DestRect: TRect; Color: TColor);
4167
procedure TDirectDrawSurface.FillRectAdd(const DestRect: TRect; Color: TColor; Alpha: Byte);
2340
var
4168
{$IFDEF DXR_deprecated}var
2341
  DestSurface: TDXR_Surface;
4169
  DestSurface: TDXR_Surface;{$ENDIF}
2342
begin
4170
begin
2343
  if Color and $FFFFFF=0 then Exit;
4171
  if Color and $FFFFFF = 0 then Exit;
2344
  if (Self.Width=0) or (Self.Height=0) then Exit;
4172
  if (Self.Width = 0) or (Self.Height = 0) then Exit;
2345
  if SurfaceDesc.ddpfPixelFormat.dwFlags and (DDPF_PALETTEINDEXED1 or DDPF_PALETTEINDEXED2 or
4173
  if SurfaceDesc.ddpfPixelFormat.dwFlags and (DDPF_PALETTEINDEXED1 or DDPF_PALETTEINDEXED2 or
2346
    DDPF_PALETTEINDEXED4 or DDPF_PALETTEINDEXED8)<>0 then Exit;
4174
    DDPF_PALETTEINDEXED4 or DDPF_PALETTEINDEXED8) <> 0 then Exit;
2347
 
4175
 
-
 
4176
  if AsSigned(D2D) and D2D.CanUseD2D and (D2D.FDDraw.Surface = Self) then begin
-
 
4177
    D2D.D2DRenderFillRect(DestRect, ColorToRGB(Color), rtAdd, Alpha);
-
 
4178
    Exit;
-
 
4179
  end;
-
 
4180
  {$IFDEF DXR_deprecated}
2348
  if dxrDDSurfaceLock(ISurface, DestSurface) then
4181
  if dxrDDSurfaceLock({$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, DestSurface) then
2349
  begin
4182
  begin
2350
    try
4183
    try
2351
      dxrFillRectColorBlend(DestSurface, DestRect, DXR_BLEND_ONE1_ADD_ONE2, ColorToRGB(Color));
4184
      dxrFillRectColorBlend(DestSurface, DestRect, DXR_BLEND_ONE1_ADD_ONE2, ColorToRGB(Color));
2352
    finally
4185
    finally
2353
      dxrDDSurfaceUnLock(ISurface, DestSurface)
4186
      dxrDDSurfaceUnLock({$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, DestSurface)
2354
    end;
4187
    end;
2355
  end;
4188
  end;
-
 
4189
  {$ENDIF}
2356
end;
4190
end;
2357
                                         
-
 
-
 
4191
 
2358
procedure TDirectDrawSurface.FillRectAlpha(const DestRect: TRect; Color: TColor;
4192
procedure TDirectDrawSurface.FillRectAlpha(const DestRect: TRect; Color: TColor;
2359
  Alpha: Integer);
4193
  Alpha: Integer);
2360
var
4194
{$IFDEF DXR_deprecated}var
2361
  DestSurface: TDXR_Surface;
4195
  DestSurface: TDXR_Surface;{$ENDIF}
2362
begin
4196
begin
2363
  if (Self.Width=0) or (Self.Height=0) then Exit;
4197
  if (Self.Width = 0) or (Self.Height = 0) then Exit;
2364
  if SurfaceDesc.ddpfPixelFormat.dwFlags and (DDPF_PALETTEINDEXED1 or DDPF_PALETTEINDEXED2 or
4198
  if SurfaceDesc.ddpfPixelFormat.dwFlags and (DDPF_PALETTEINDEXED1 or DDPF_PALETTEINDEXED2 or
2365
    DDPF_PALETTEINDEXED4 or DDPF_PALETTEINDEXED8)<>0 then Exit;
4199
    DDPF_PALETTEINDEXED4 or DDPF_PALETTEINDEXED8) <> 0 then Exit;
2366
 
4200
 
-
 
4201
  if AsSigned(D2D) and D2D.CanUseD2D and (D2D.FDDraw.Surface = Self) then begin
-
 
4202
    D2D.D2DRenderFillRect(DestRect, ColorToRGB(Color), rtBlend, Alpha);
-
 
4203
    Exit;
-
 
4204
  end;
-
 
4205
  {$IFDEF DXR_deprecated}
2367
  if dxrDDSurfaceLock(ISurface, DestSurface) then
4206
  if dxrDDSurfaceLock({$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, DestSurface) then
2368
  begin
4207
  begin
2369
    try
4208
    try
2370
      dxrFillRectColorBlend(DestSurface, DestRect, DXR_BLEND_SRCALPHA1_ADD_INVSRCALPHA2, ColorToRGB(Color) or (Byte(Alpha) shl 24));
4209
      dxrFillRectColorBlend(DestSurface, DestRect, DXR_BLEND_SRCALPHA1_ADD_INVSRCALPHA2, ColorToRGB(Color) or (Byte(Alpha) shl 24));
2371
    finally
4210
    finally
2372
      dxrDDSurfaceUnLock(ISurface, DestSurface)
4211
      dxrDDSurfaceUnLock({$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, DestSurface)
2373
    end;
4212
    end;
2374
  end;
4213
  end;{$ENDIF}
2375
end;
4214
end;
2376
 
4215
 
2377
procedure TDirectDrawSurface.FillRectSub(const DestRect: TRect; Color: TColor);
4216
procedure TDirectDrawSurface.FillRectSub(const DestRect: TRect; Color: TColor; Alpha: Byte);
2378
var
4217
{$IFDEF DXR_deprecated}var
2379
  DestSurface: TDXR_Surface;
4218
  DestSurface: TDXR_Surface;{$ENDIF}
2380
begin
4219
begin
2381
  if Color and $FFFFFF=0 then Exit;
4220
  if Color and $FFFFFF = 0 then Exit;
2382
  if (Self.Width=0) or (Self.Height=0) then Exit;
4221
  if (Self.Width = 0) or (Self.Height = 0) then Exit;
2383
  if SurfaceDesc.ddpfPixelFormat.dwFlags and (DDPF_PALETTEINDEXED1 or DDPF_PALETTEINDEXED2 or
4222
  if SurfaceDesc.ddpfPixelFormat.dwFlags and (DDPF_PALETTEINDEXED1 or DDPF_PALETTEINDEXED2 or
2384
    DDPF_PALETTEINDEXED4 or DDPF_PALETTEINDEXED8)<>0 then Exit;
4223
    DDPF_PALETTEINDEXED4 or DDPF_PALETTEINDEXED8) <> 0 then Exit;
2385
 
4224
 
-
 
4225
  if AsSigned(D2D) and D2D.CanUseD2D and (D2D.FDDraw.Surface = Self) then begin
-
 
4226
    D2D.D2DRenderFillRect(DestRect, ColorToRGB(Color), rtSub, Alpha);
-
 
4227
    Exit;
-
 
4228
  end;
-
 
4229
  {$IFDEF DXR_deprecated}
2386
  if dxrDDSurfaceLock(ISurface, DestSurface) then
4230
  if dxrDDSurfaceLock({$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, DestSurface) then
2387
  begin
4231
  begin
2388
    try
4232
    try
2389
      dxrFillRectColorBlend(DestSurface, DestRect, DXR_BLEND_ONE2_SUB_ONE1, ColorToRGB(Color));
4233
      dxrFillRectColorBlend(DestSurface, DestRect, DXR_BLEND_ONE2_SUB_ONE1, ColorToRGB(Color));
2390
    finally
4234
    finally
2391
      dxrDDSurfaceUnLock(ISurface, DestSurface)
4235
      dxrDDSurfaceUnLock({$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, DestSurface)
2392
    end;
4236
    end;
2393
  end;
4237
  end;{$ENDIF}
2394
end;
4238
end;
2395
 
4239
 
2396
function TDirectDrawSurface.GetBitCount: Integer;
4240
function TDirectDrawSurface.GetBitCount: Integer;
2397
begin
4241
begin
2398
  Result := SurfaceDesc.ddpfPixelFormat.dwRGBBitCount;
4242
  Result := SurfaceDesc.ddpfPixelFormat.dwRGBBitCount;
2399
end;
4243
end;
2400
 
4244
 
2401
function TDirectDrawSurface.GetCanvas: TDirectDrawSurfaceCanvas;
4245
function TDirectDrawSurface.GetCanvas: TDirectDrawSurfaceCanvas;
2402
begin
4246
begin
2403
  if FCanvas=nil then
4247
  if FCanvas = nil then
2404
    FCanvas := TDirectDrawSurfaceCanvas.Create(Self);
4248
    FCanvas := TDirectDrawSurfaceCanvas.Create(Self);
2405
  Result := FCanvas;
4249
  Result := FCanvas;
2406
end;
4250
end;
2407
 
4251
 
2408
function TDirectDrawSurface.GetClientRect: TRect;
4252
function TDirectDrawSurface.GetClientRect: TRect;
Line 2421... Line 4265...
2421
    R, G, B: Byte;
4265
    R, G, B: Byte;
2422
  end;
4266
  end;
2423
 
4267
 
2424
function TDirectDrawSurface.GetPixel(X, Y: Integer): Longint;
4268
function TDirectDrawSurface.GetPixel(X, Y: Integer): Longint;
2425
var
4269
var
2426
  ddsd: TDDSurfaceDesc;
4270
  ddsd: {$IFDEF D3D_deprecated}TDDSurfaceDesc{$ELSE}TDDSurfaceDesc2{$ENDIF};
2427
begin
4271
begin
2428
  Result := 0;
4272
  Result := 0;
2429
  if (IDDSurface<>nil) and (X>=0) and (X<Width) and (Y>=0) and (Y<Height) then
4273
  if ({$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF} <> nil) and (X >= 0) and (X < Width) and (Y >= 0) and (Y < Height) then
2430
    if Lock(PRect(nil)^, ddsd) then
4274
    if Lock(PRect(nil)^, ddsd) then
2431
    begin
4275
    begin
2432
      try
4276
      try
2433
        case ddsd.ddpfPixelFormat.dwRGBBitCount of
4277
        case ddsd.ddpfPixelFormat.dwRGBBitCount of
2434
          1 : Result := Integer(PByte(Integer(ddsd.lpSurface)+
4278
          1: Result := Integer(PByte(Integer(ddsd.lpSurface) +
2435
                Y*ddsd.lPitch+(X shr 3))^ and (1 shl (X and 7))<>0);
4279
              Y * ddsd.lPitch + (X shr 3))^ and (1 shl (X and 7)) <> 0);
2436
          4 : begin
4280
          4: begin
2437
                if X and 1=0 then
4281
              if X and 1 = 0 then
2438
                  Result := PByte(Integer(ddsd.lpSurface)+Y*ddsd.lPitch+(X shr 1))^ shr 4
4282
                Result := PByte(Integer(ddsd.lpSurface) + Y * ddsd.lPitch + (X shr 1))^ shr 4
2439
                else
4283
              else
2440
                  Result := PByte(Integer(ddsd.lpSurface)+Y*ddsd.lPitch+(X shr 1))^ and $0F;
4284
                Result := PByte(Integer(ddsd.lpSurface) + Y * ddsd.lPitch + (X shr 1))^ and $0F;
2441
              end;
4285
            end;
2442
          8 : Result := PByte(Integer(ddsd.lpSurface)+Y*ddsd.lPitch+X)^;
4286
          8: Result := PByte(Integer(ddsd.lpSurface) + Y * ddsd.lPitch + X)^;
2443
          16: Result := PWord(Integer(ddsd.lpSurface)+Y*ddsd.lPitch+X*2)^;
4287
          16: Result := PWord(Integer(ddsd.lpSurface) + Y * ddsd.lPitch + X * 2)^;
2444
          24: with PRGB(Integer(ddsd.lpSurface)+Y*ddsd.lPitch+X*3)^ do
4288
          24: with PRGB(Integer(ddsd.lpSurface) + Y * ddsd.lPitch + X * 3)^ do
2445
                Result := R or (G shl 8) or (B shl 16);
4289
              Result := R or (G shl 8) or (B shl 16);
2446
          32: Result := PInteger(Integer(ddsd.lpSurface)+Y*ddsd.lPitch+X*4)^;
4290
          32: Result := PInteger(Integer(ddsd.lpSurface) + Y * ddsd.lPitch + X * 4)^;
2447
        end;
4291
        end;
2448
      finally
4292
      finally
2449
        UnLock;
4293
        UnLock;
2450
      end;
4294
      end;
2451
    end;
4295
    end;
Line 2473... Line 4317...
2473
 
4317
 
2474
procedure TDirectDrawSurface.LoadFromGraphicRect(Graphic: TGraphic; AWidth, AHeight: Integer; const SrcRect: TRect);
4318
procedure TDirectDrawSurface.LoadFromGraphicRect(Graphic: TGraphic; AWidth, AHeight: Integer; const SrcRect: TRect);
2475
var
4319
var
2476
  Temp: TDIB;
4320
  Temp: TDIB;
2477
begin
4321
begin
2478
  if AWidth=0 then
4322
  if AWidth = 0 then
2479
    AWidth := SrcRect.Right-SrcRect.Left;
4323
    AWidth := SrcRect.Right - SrcRect.Left;
2480
  if AHeight=0 then
4324
  if AHeight = 0 then
2481
    AHeight := SrcRect.Bottom-SrcRect.Top;
4325
    AHeight := SrcRect.Bottom - SrcRect.Top;
2482
 
4326
 
2483
  SetSize(AWidth, AHeight);
4327
  SetSize(AWidth, AHeight);
2484
 
4328
 
2485
  with SrcRect do
4329
  with SrcRect do
2486
    if Graphic is TDIB then
4330
    if Graphic is TDIB then
2487
    begin
4331
    begin
2488
      with Canvas do
4332
      with Canvas do
2489
      begin
4333
      try
2490
        StretchBlt(Handle, 0, 0, AWidth, AHeight, TDIB(Graphic).Canvas.Handle,
4334
        StretchBlt(Handle, 0, 0, AWidth, AHeight, TDIB(Graphic).Canvas.Handle,
2491
          Left, Top, Right-Left, Bottom-Top,SRCCOPY);
4335
          Left, Top, Right - Left, Bottom - Top, SRCCOPY);
-
 
4336
      finally
2492
        Release;
4337
        Release;
2493
      end;
4338
      end;
2494
    end else if (Right-Left=AWidth) and (Bottom-Top=AHeight) then
4339
    end else if (Right - Left = AWidth) and (Bottom - Top = AHeight) then
2495
    begin
4340
    begin
2496
      with Canvas do
4341
      with Canvas do
2497
      begin
4342
      try
2498
        Draw(-Left, -Top, Graphic);
4343
        Draw(-Left, -Top, Graphic);
-
 
4344
      finally
2499
        Release;
4345
        Release;
2500
      end;
4346
      end;
2501
    end else
4347
    end else
2502
    begin
4348
    begin
2503
      Temp := TDIB.Create;
4349
      Temp := TDIB.Create;
2504
      try
4350
      try
2505
        Temp.SetSize(Right-Left, Bottom-Top, 24);
4351
        Temp.SetSize(Right - Left, Bottom - Top, 24);
2506
        Temp.Canvas.Draw(-Left, -Top, Graphic);
4352
        Temp.Canvas.Draw(-Left, -Top, Graphic);
2507
 
4353
 
2508
        with Canvas do
4354
        with Canvas do
2509
        begin
4355
        try
2510
          StretchDraw(Bounds(0, 0, AWidth, AHeight), Temp);
4356
          StretchDraw(Bounds(0, 0, AWidth, AHeight), Temp);
-
 
4357
        finally
2511
          Release;
4358
          Release;
2512
        end;
4359
        end;
2513
      finally
4360
      finally
2514
        Temp.Free;
4361
        Temp.Free;
2515
      end;
4362
      end;
Line 2534... Line 4381...
2534
  DIB: TDIB;
4381
  DIB: TDIB;
2535
begin
4382
begin
2536
  DIB := TDIB.Create;
4383
  DIB := TDIB.Create;
2537
  try
4384
  try
2538
    DIB.LoadFromStream(Stream);
4385
    DIB.LoadFromStream(Stream);
2539
    if DIB.Size>0 then
4386
    if DIB.Size > 0 then
2540
      LoadFromGraphic(DIB);
4387
      LoadFromGraphic(DIB);
2541
  finally
4388
  finally
2542
    DIB.Free;                
4389
    DIB.Free;
2543
  end;
4390
  end;
2544
end;
4391
end;
2545
 
4392
 
2546
function TDirectDrawSurface.Lock(const Rect: TRect; var SurfaceDesc: TDDSurfaceDesc): Boolean;
4393
function TDirectDrawSurface.Lock(const Rect: TRect; var SurfaceDesc: {$IFDEF D3D_deprecated}TDDSurfaceDesc{$ELSE}TDDSurfaceDesc2{$ENDIF}): Boolean;
2547
begin
4394
begin
2548
  Result := False;
4395
  Result := False;
2549
  if IDDSurface=nil then Exit;
4396
  if {$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF} = nil then Exit;
2550
 
-
 
2551
  if FLockCount>0 then Exit;
-
 
2552
 
4397
 
-
 
4398
  if FLockCount > 0 then Exit;
-
 
4399
  FIsLocked := False;
2553
  FLockSurfaceDesc.dwSize := SizeOf(FLockSurfaceDesc);
4400
  FLockSurfaceDesc.dwSize := SizeOf(FLockSurfaceDesc);
2554
 
4401
 
2555
  if (@Rect<>nil) and ((Rect.Left<>0) or (Rect.Top<>0) or (Rect.Right<>Width) or (Rect.Bottom<>Height)) then
4402
  if (@Rect <> nil) and ((Rect.Left <> 0) or (Rect.Top <> 0) or (Rect.Right <> Width) or (Rect.Bottom <> Height)) then
2556
    DXResult := ISurface.Lock(@Rect, FLockSurfaceDesc, DDLOCK_WAIT, 0)
4403
    DXResult := {$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}.Lock(@Rect, FLockSurfaceDesc, DDLOCK_WAIT, 0)
2557
  else                                                                
-
 
-
 
4404
  else
2558
    DXResult := ISurface.Lock(nil, FLockSurfaceDesc, DDLOCK_WAIT, 0);
4405
    DXResult := {$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}.Lock(nil, FLockSurfaceDesc, DDLOCK_WAIT, 0);
2559
  if DXResult<>DD_OK then Exit;
4406
  if DXResult <> DD_OK then Exit;
2560
 
4407
 
2561
  Inc(FLockCount);
4408
  Inc(FLockCount);
2562
  SurfaceDesc := FLockSurfaceDesc;
4409
  SurfaceDesc := FLockSurfaceDesc;
2563
 
-
 
-
 
4410
  FIsLocked := True;
2564
  Result := True;
4411
  Result := True;
2565
end;
4412
end;
2566
                   
-
 
-
 
4413
 
2567
{$IFDEF DelphiX_Spt4}
4414
{$IFDEF VER4UP}
2568
function TDirectDrawSurface.Lock(var SurfaceDesc: TDDSurfaceDesc): Boolean;
4415
function TDirectDrawSurface.Lock(var SurfaceDesc: {$IFDEF D3D_deprecated}TDDSurfaceDesc{$ELSE}TDDSurfaceDesc2{$ENDIF}): Boolean;
2569
begin
4416
begin
2570
  Result := False;
4417
  Result := False;
2571
  if IDDSurface=nil then Exit;
4418
  FIsLocked := False;
-
 
4419
  if {$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF} = nil then Exit;
2572
 
4420
 
2573
  if FLockCount=0 then
4421
  if FLockCount = 0 then
2574
  begin
4422
  begin
2575
    FLockSurfaceDesc.dwSize := SizeOf(FLockSurfaceDesc);
4423
    FLockSurfaceDesc.dwSize := SizeOf(FLockSurfaceDesc);
2576
    DXResult := ISurface.Lock(nil, FLockSurfaceDesc, DDLOCK_WAIT, 0);
4424
    DXResult := {$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}.Lock(nil, FLockSurfaceDesc, DDLOCK_WAIT, 0);
2577
    if DXResult<>DD_OK then Exit;
4425
    if DXResult <> DD_OK then Exit;
2578
  end;
4426
  end;
2579
 
4427
 
2580
  Inc(FLockCount);
4428
  Inc(FLockCount);
2581
  SurfaceDesc := FLockSurfaceDesc;
4429
  SurfaceDesc := FLockSurfaceDesc;
-
 
4430
  FIsLocked := True;
2582
  Result := True;
4431
  Result := True;
2583
end;
4432
end;
-
 
4433
 
-
 
4434
function TDirectDrawSurface.Lock: Boolean;
-
 
4435
var SurfaceDesc: {$IFDEF D3D_deprecated}TDDSurfaceDesc{$ELSE}TDDSurfaceDesc2{$ENDIF};
-
 
4436
begin
-
 
4437
  Result := Lock(SurfaceDesc);
-
 
4438
end;
-
 
4439
 
-
 
4440
{$ELSE}
-
 
4441
 
-
 
4442
function TDirectDrawSurface.LockSurface: Boolean;
-
 
4443
var SurfaceDesc: {$IFDEF D3D_deprecated}TDDSurfaceDesc{$ELSE}TDDSurfaceDesc2{$ENDIF}; R: TRect;
-
 
4444
begin
-
 
4445
  Result := Lock(R, SurfaceDesc);
-
 
4446
end;
2584
{$ENDIF}
4447
{$ENDIF}
2585
 
4448
 
2586
procedure TDirectDrawSurface.UnLock;
4449
procedure TDirectDrawSurface.UnLock;
2587
begin
4450
begin
2588
  if IDDSurface=nil then Exit;
4451
  if {$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF} = nil then Exit;
2589
 
4452
 
2590
  if FLockCount>0 then
4453
  if FLockCount > 0 then
2591
  begin
4454
  begin
2592
    Dec(FLockCount);
4455
    Dec(FLockCount);
2593
    if FLockCount=0 then
4456
    if FLockCount = 0 then begin
2594
      DXResult := ISurface.UnLock(FLockSurfaceDesc.lpSurface);
4457
      DXResult := {$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}.UnLock(FLockSurfaceDesc.lpSurface);
-
 
4458
      FIsLocked := False;
-
 
4459
    end;
2595
  end;
4460
  end;
2596
end;
4461
end;
2597
 
4462
 
2598
function TDirectDrawSurface.Restore: Boolean;
4463
function TDirectDrawSurface.Restore: Boolean;
2599
begin
4464
begin
2600
  if IDDSurface<>nil then
4465
  if {$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF} <> nil then
2601
  begin
4466
  begin
2602
    DXResult := ISurface.Restore;
4467
    DXResult := {$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}._Restore;
2603
    Result := DXResult=DD_OK;
4468
    Result := DXResult = DD_OK;
2604
  end else
4469
  end else
2605
    Result := False;
4470
    Result := False;
2606
end;
4471
end;
2607
 
4472
 
2608
procedure TDirectDrawSurface.SetClipper(Value: TDirectDrawClipper);
4473
procedure TDirectDrawSurface.SetClipper(Value: TDirectDrawClipper);
2609
begin
4474
begin
2610
  if IDDSurface<>nil then
4475
  if {$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF} <> nil then
2611
    DXResult := ISurface.SetClipper(Value.IDDClipper);
4476
    DXResult := {$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}.SetClipper(Value.IDDClipper);
2612
  FHasClipper := (Value<>nil) and (DXResult=DD_OK);
4477
  FHasClipper := (Value <> nil) and (DXResult = DD_OK);
2613
end;
4478
end;
2614
 
4479
 
2615
procedure TDirectDrawSurface.SetColorKey(Flags: DWORD; const Value: TDDColorKey);
4480
procedure TDirectDrawSurface.SetColorKey(Flags: DWORD; const Value: TDDColorKey);
2616
begin
4481
begin
2617
  if IDDSurface<>nil then
4482
  if {$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF} <> nil then
2618
    DXResult := ISurface.SetColorKey(Flags, Value);
4483
    DXResult := {$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}.SetColorKey(Flags, @Value);
2619
end;
4484
end;
2620
 
4485
 
2621
procedure TDirectDrawSurface.SetPalette(Value: TDirectDrawPalette);
4486
procedure TDirectDrawSurface.SetPalette(Value: TDirectDrawPalette);
2622
begin
4487
begin
2623
  if IDDSurface<>nil then
4488
  if {$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF} <> nil then
2624
    DXResult := ISurface.SetPalette(Value.IDDPalette);
4489
    DXResult := {$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}.SetPalette(Value.IDDPalette);
2625
end;
4490
end;
2626
 
4491
 
2627
procedure TDirectDrawSurface.SetPixel(X, Y: Integer; Value: Longint);
4492
procedure TDirectDrawSurface.SetPixel(X, Y: Integer; Value: Longint);
2628
var
4493
var
2629
  ddsd: TDDSurfaceDesc;
4494
  ddsd: {$IFDEF D3D_deprecated}TDDSurfaceDesc{$ELSE}TDDSurfaceDesc2{$ENDIF};
2630
  P: PByte;
4495
  P: PByte;
2631
begin
4496
begin
2632
  if (IDDSurface<>nil) and (X>=0) and (X<Width) and (Y>=0) and (Y<Height) then
4497
  if ({$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF} <> nil) and (X >= 0) and (X < Width) and (Y >= 0) and (Y < Height) then
2633
    if Lock(PRect(nil)^, ddsd) then
4498
    if Lock(PRect(nil)^, ddsd) then
2634
    begin
4499
    begin
2635
      try
4500
      try
2636
        case ddsd.ddpfPixelFormat.dwRGBBitCount of
4501
        case ddsd.ddpfPixelFormat.dwRGBBitCount of
2637
          1 : begin
4502
          1: begin
2638
                P := PByte(Integer(ddsd.lpSurface)+Y*ddsd.lPitch+(X shr 3));
4503
              P := PByte(Integer(ddsd.lpSurface) + Y * ddsd.lPitch + (X shr 3));
2639
                if Value=0 then
4504
              if Value = 0 then
2640
                  P^ := P^ and (not (1 shl (7-(X and 7))))
4505
                P^ := P^ and (not (1 shl (7 - (X and 7))))
2641
                else
4506
              else
2642
                  P^ := P^ or (1 shl (7-(X and 7)));
4507
                P^ := P^ or (1 shl (7 - (X and 7)));
2643
              end;
4508
            end;
2644
          4 : begin
4509
          4: begin
2645
                P := PByte(Integer(ddsd.lpSurface)+Y*ddsd.lPitch+(X shr 1));
4510
              P := PByte(Integer(ddsd.lpSurface) + Y * ddsd.lPitch + (X shr 1));
2646
                if X and 1=0 then
4511
              if X and 1 = 0 then
2647
                  P^ := (P^ and $0F) or (Value shl 4)
4512
                P^ := (P^ and $0F) or (Value shl 4)
2648
                else
4513
              else
2649
                  P^ := (P^ and $F0) or (Value and $0F);
4514
                P^ := (P^ and $F0) or (Value and $0F);
2650
              end;
4515
            end;
2651
          8 : PByte(Integer(ddsd.lpSurface)+Y*ddsd.lPitch+X)^ := Value;
4516
          8: PByte(Integer(ddsd.lpSurface) + Y * ddsd.lPitch + X)^ := Value;
2652
          16: PWord(Integer(ddsd.lpSurface)+Y*ddsd.lPitch+X*2)^ := Value;
4517
          16: PWord(Integer(ddsd.lpSurface) + Y * ddsd.lPitch + X * 2)^ := Value;
2653
          24: with PRGB(Integer(ddsd.lpSurface)+Y*ddsd.lPitch+X*3)^ do
4518
          24: with PRGB(Integer(ddsd.lpSurface) + Y * ddsd.lPitch + X * 3)^ do
2654
              begin
4519
            begin
2655
                R := Byte(Value);
4520
              R := Byte(Value);
2656
                G := Byte(Value shr 8);
4521
              G := Byte(Value shr 8);
2657
                B := Byte(Value shr 16);
4522
              B := Byte(Value shr 16);
2658
              end;
4523
            end;
2659
          32: PInteger(Integer(ddsd.lpSurface)+Y*ddsd.lPitch+X*4)^ := Value;
4524
          32: PInteger(Integer(ddsd.lpSurface) + Y * ddsd.lPitch + X * 4)^ := Value;
2660
        end;
4525
        end;
2661
      finally
4526
      finally
2662
        UnLock;
4527
        UnLock;
2663
      end;
4528
      end;
2664
    end;
4529
    end;
2665
end;
4530
end;
2666
 
4531
 
2667
procedure TDirectDrawSurface.SetSize(AWidth, AHeight: Integer);
4532
procedure TDirectDrawSurface.SetSize(AWidth, AHeight: Integer);
2668
var
4533
var
2669
  ddsd: TDDSurfaceDesc;
4534
  ddsd: {$IFDEF D3D_deprecated}TDDSurfaceDesc{$ELSE}TDDSurfaceDesc2{$ENDIF};
2670
begin
4535
begin
2671
  if (AWidth<=0) or (AHeight<=0) then
4536
  if (AWidth <= 0) or (AHeight <= 0) then
2672
  begin
4537
  begin
2673
    IDDSurface := nil;
4538
    {$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF} := nil;
2674
    Exit;
4539
    Exit;
2675
  end;
4540
  end;
2676
 
4541
 
-
 
4542
  FillChar(ddsd, SizeOf(ddsd), 0);
2677
  with ddsd do
4543
  with ddsd do
2678
  begin
4544
  begin
2679
    dwSize := SizeOf(ddsd);
4545
    dwSize := SizeOf(ddsd);
2680
    dwFlags := DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT;
4546
    dwFlags := DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT;
2681
    ddsCaps.dwCaps := DDSCAPS_OFFSCREENPLAIN;
4547
    ddsCaps.dwCaps := DDSCAPS_OFFSCREENPLAIN;
Line 2686... Line 4552...
2686
  end;
4552
  end;
2687
 
4553
 
2688
  if CreateSurface(ddsd) then Exit;
4554
  if CreateSurface(ddsd) then Exit;
2689
 
4555
 
2690
  {  When the Surface cannot be made,  making is attempted to the system memory.  }
4556
  {  When the Surface cannot be made,  making is attempted to the system memory.  }
2691
  if ddsd.ddsCaps.dwCaps and DDSCAPS_SYSTEMMEMORY=0 then
4557
  if ddsd.ddsCaps.dwCaps and DDSCAPS_SYSTEMMEMORY = 0 then
2692
  begin
4558
  begin
2693
    ddsd.ddsCaps.dwCaps := (ddsd.ddsCaps.dwCaps and (not DDSCAPS_VIDEOMEMORY)) or DDSCAPS_SYSTEMMEMORY;
4559
    ddsd.ddsCaps.dwCaps := (ddsd.ddsCaps.dwCaps and (not DDSCAPS_VIDEOMEMORY)) or DDSCAPS_SYSTEMMEMORY;
2694
    if CreateSurface(ddsd) then
4560
    if CreateSurface(ddsd) then
2695
    begin
4561
    begin
2696
      FSystemMemory := True;
4562
      FSystemMemory := True;
Line 2708... Line 4574...
2708
  ddck.dwColorSpaceLowValue := Col;
4574
  ddck.dwColorSpaceLowValue := Col;
2709
  ddck.dwColorSpaceHighValue := Col;
4575
  ddck.dwColorSpaceHighValue := Col;
2710
  ColorKey[DDCKEY_SRCBLT] := ddck;
4576
  ColorKey[DDCKEY_SRCBLT] := ddck;
2711
end;
4577
end;
2712
 
4578
 
-
 
4579
{additional pixel routines like turbopixels}
-
 
4580
 
-
 
4581
procedure TDirectDrawSurface.PutPixel8(x, y, color: Integer); assembler;
-
 
4582
{ on entry:  self = eax, x = edx,   y = ecx,   color = ? }
-
 
4583
asm
-
 
4584
  push esi                              // must maintain esi
-
 
4585
  mov esi,TDirectDrawSurface[eax].FLockSurfaceDesc.lpSurface// set to surface
-
 
4586
  add esi,edx                           // add x
-
 
4587
  mov eax,[TDirectDrawSurface[eax].FLockSurfaceDesc.dwwidth]  // eax = pitch
-
 
4588
  mul ecx                               // eax = pitch * y
-
 
4589
  add esi,eax                           // esi = pixel offset
-
 
4590
  mov ecx, color
-
 
4591
  mov ds:[esi],cl                       // set pixel (lo byte of ecx)
-
 
4592
  pop esi                               // restore esi
-
 
4593
  //ret                                   // return
-
 
4594
end;
-
 
4595
 
-
 
4596
procedure TDirectDrawSurface.PutPixel16(x, y, color: Integer); assembler;
-
 
4597
{ on entry:  self = eax, x = edx,   y = ecx,   color = ? }
-
 
4598
asm
-
 
4599
  push esi
-
 
4600
  mov esi,TDirectDrawSurface[eax].FLockSurfaceDesc.lpSurface
-
 
4601
  shl edx,1
-
 
4602
  add esi,edx
-
 
4603
  mov eax,[TDirectDrawSurface[eax].FLockSurfaceDesc.lpitch]
-
 
4604
  mul ecx
-
 
4605
  add esi,eax
-
 
4606
  mov ecx, color
-
 
4607
  mov ds:[esi],cx
-
 
4608
  pop esi
-
 
4609
  //ret
-
 
4610
end;
-
 
4611
 
-
 
4612
procedure TDirectDrawSurface.PutPixel24(x, y, color: Integer); assembler;
-
 
4613
{ on entry:  self = eax, x = edx,   y = ecx,   color = ? }
-
 
4614
asm
-
 
4615
  push esi
-
 
4616
  mov esi,TDirectDrawSurface[eax].FLockSurfaceDesc.lpSurface
-
 
4617
  imul edx,3
-
 
4618
  add esi,edx
-
 
4619
  mov eax,[TDirectDrawSurface[eax].FLockSurfaceDesc.lpitch]
-
 
4620
  mul ecx
-
 
4621
  add esi,eax
-
 
4622
  mov eax,ds:[esi]
-
 
4623
  and eax,$FF000000
-
 
4624
  mov ecx, color
-
 
4625
  or  ecx,eax
-
 
4626
  mov ds:[esi+1],ecx
-
 
4627
  pop esi
-
 
4628
  //ret
-
 
4629
end;
-
 
4630
 
-
 
4631
procedure TDirectDrawSurface.PutPixel32(x, y, color: Integer); assembler;
-
 
4632
{ on entry:  self = eax, x = edx,   y = ecx,   color = ? }
-
 
4633
asm
-
 
4634
  push esi
-
 
4635
  mov esi,TDirectDrawSurface[eax].FLockSurfaceDesc.lpSurface
-
 
4636
  shl edx,2
-
 
4637
  add esi,edx
-
 
4638
  mov eax,[TDirectDrawSurface[eax].FLockSurfaceDesc.lpitch]
-
 
4639
  mul ecx
-
 
4640
  add esi,eax
-
 
4641
  mov ecx, color
-
 
4642
  mov ds:[esi],ecx
-
 
4643
  pop esi
-
 
4644
  //ret
-
 
4645
end;
-
 
4646
 
-
 
4647
procedure TDirectDrawSurface.Poke(X, Y: Integer; const Value: LongInt);
-
 
4648
begin
-
 
4649
  if (X < 0) or (X > (Width - 1)) or
-
 
4650
    (Y < 0) or (Y > (Height - 1)) or not FIsLocked then Exit;
-
 
4651
  case Bitcount of
-
 
4652
    8: PutPixel8(x, y, value);
-
 
4653
    16: PutPixel16(x, y, value);
-
 
4654
    24: PutPixel24(x, y, value);
-
 
4655
    32: PutPixel32(x, y, value);
-
 
4656
  end;
-
 
4657
end;
-
 
4658
 
-
 
4659
function TDirectDrawSurface.GetPixel8(x, y: Integer): Integer; assembler;
-
 
4660
{ on entry:  self = eax, x = edx,   y = ecx,   result = eax }
-
 
4661
asm
-
 
4662
  push esi                              // myst maintain esi
-
 
4663
  mov esi,TDirectDrawSurface[eax].FLockSurfaceDesc.lpSurface        // set to surface
-
 
4664
  add esi,edx                           // add x
-
 
4665
  mov eax,[TDirectDrawSurface[eax].FLockSurfaceDesc.lpitch]         // eax = pitch
-
 
4666
  mul ecx                               // eax = pitch * y
-
 
4667
  add esi,eax                           // esi = pixel offset
-
 
4668
  mov eax,ds:[esi]                      // eax = color
-
 
4669
  and eax,$FF                           // map into 8bit
-
 
4670
  pop esi                               // restore esi
-
 
4671
  //ret                                   // return
-
 
4672
end;
-
 
4673
 
-
 
4674
function TDirectDrawSurface.GetPixel16(x, y: Integer): Integer; assembler;
-
 
4675
{ on entry:  self = eax, x = edx,   y = ecx,   result = eax }
-
 
4676
asm
-
 
4677
  push esi
-
 
4678
  mov esi,TDirectDrawSurface[eax].FLockSurfaceDesc.lpSurface
-
 
4679
  shl edx,1
-
 
4680
  add esi,edx
-
 
4681
  mov eax,[TDirectDrawSurface[eax].FLockSurfaceDesc.lpitch]
-
 
4682
  mul ecx
-
 
4683
  add esi,eax
-
 
4684
  mov eax,ds:[esi]
-
 
4685
  and eax,$FFFF                         // map into 16bit
-
 
4686
  pop esi
-
 
4687
  //ret
-
 
4688
end;
-
 
4689
 
-
 
4690
function TDirectDrawSurface.GetPixel24(x, y: Integer): Integer; assembler;
-
 
4691
{ on entry:  self = eax, x = edx,   y = ecx,   result = eax }
-
 
4692
asm
-
 
4693
  push esi
-
 
4694
  mov esi,TDirectDrawSurface[eax].FLockSurfaceDesc.lpSurface
-
 
4695
  imul edx,3
-
 
4696
  add esi,edx
-
 
4697
  mov eax,[TDirectDrawSurface[eax].FLockSurfaceDesc.lpitch]
-
 
4698
  mul ecx
-
 
4699
  add esi,eax
-
 
4700
  mov eax,ds:[esi]
-
 
4701
  and eax,$FFFFFF                       // map into 24bit
-
 
4702
  pop esi
-
 
4703
  //ret
-
 
4704
end;
-
 
4705
 
-
 
4706
function TDirectDrawSurface.GetPixel32(x, y: Integer): Integer; assembler;
-
 
4707
{ on entry:  self = eax, x = edx,   y = ecx,   result = eax }
-
 
4708
asm
-
 
4709
  push esi
-
 
4710
  mov esi,TDirectDrawSurface[eax].FLockSurfaceDesc.lpSurface
-
 
4711
  shl edx,2
-
 
4712
  add esi,edx
-
 
4713
  mov eax,[TDirectDrawSurface[eax].FLockSurfaceDesc.lpitch]
-
 
4714
  mul ecx
-
 
4715
  add esi,eax
-
 
4716
  mov eax,ds:[esi]
-
 
4717
  pop esi
-
 
4718
  //ret
-
 
4719
end;
-
 
4720
 
-
 
4721
function TDirectDrawSurface.Peek(X, Y: Integer): LongInt;
-
 
4722
begin
-
 
4723
  Result := 0;
-
 
4724
  if (X < 0) or (X > (Width - 1)) or
-
 
4725
    (Y < 0) or (Y > (Height - 1)) or not FIsLocked then Exit;
-
 
4726
  case Bitcount of
-
 
4727
    8: Result := GetPixel8(x, y);
-
 
4728
    16: Result := GetPixel16(x, y);
-
 
4729
    24: Result := GetPixel24(x, y);
-
 
4730
    32: Result := GetPixel32(x, y);
-
 
4731
  end;
-
 
4732
end;
-
 
4733
 
-
 
4734
procedure TDirectDrawSurface.PokeLine(X1, Y1, X2, Y2: Integer; Color: cardinal);
-
 
4735
var
-
 
4736
  i, deltax, deltay, numpixels,
-
 
4737
    d, dinc1, dinc2,
-
 
4738
    x, xinc1, xinc2,
-
 
4739
    y, yinc1, yinc2: Integer;
-
 
4740
begin
-
 
4741
  if not FIsLocked then {$IFDEF VER4UP}Lock{$ELSE}LockSurface{$ENDIF}; //force lock the surface
-
 
4742
  { Calculate deltax and deltay for initialisation }
-
 
4743
  deltax := abs(x2 - x1);
-
 
4744
  deltay := abs(y2 - y1);
-
 
4745
 
-
 
4746
  { Initialise all vars based on which is the independent variable }
-
 
4747
  if deltax >= deltay then
-
 
4748
  begin
-
 
4749
    { x is independent variable }
-
 
4750
    numpixels := deltax + 1;
-
 
4751
    d := (2 * deltay) - deltax;
-
 
4752
 
-
 
4753
    dinc1 := deltay shl 1;
-
 
4754
    dinc2 := (deltay - deltax) shl 1;
-
 
4755
    xinc1 := 1;
-
 
4756
    xinc2 := 1;
-
 
4757
    yinc1 := 0;
-
 
4758
    yinc2 := 1;
-
 
4759
  end
-
 
4760
  else
-
 
4761
  begin
-
 
4762
    { y is independent variable }
-
 
4763
    numpixels := deltay + 1;
-
 
4764
    d := (2 * deltax) - deltay;
-
 
4765
    dinc1 := deltax shl 1;
-
 
4766
    dinc2 := (deltax - deltay) shl 1;
-
 
4767
    xinc1 := 0;
-
 
4768
    xinc2 := 1;
-
 
4769
    yinc1 := 1;
-
 
4770
    yinc2 := 1;
-
 
4771
  end;
-
 
4772
  { Make sure x and y move in the right directions }
-
 
4773
  if x1 > x2 then
-
 
4774
  begin
-
 
4775
    xinc1 := -xinc1;
-
 
4776
    xinc2 := -xinc2;
-
 
4777
  end;
-
 
4778
  if y1 > y2 then
-
 
4779
  begin
-
 
4780
    yinc1 := -yinc1;
-
 
4781
    yinc2 := -yinc2;
-
 
4782
  end;
-
 
4783
  x := x1;
-
 
4784
  y := y1;
-
 
4785
  { Draw the pixels }
-
 
4786
  for i := 1 to numpixels do
-
 
4787
  begin
-
 
4788
    if (x > 0) and (x < (Width - 1)) and (y > 0) and (y < (Height - 1)) then
-
 
4789
      Pixel[x, y] := Color;
-
 
4790
    if d < 0 then
-
 
4791
    begin
-
 
4792
      Inc(d, dinc1);
-
 
4793
      Inc(x, xinc1);
-
 
4794
      Inc(y, yinc1);
-
 
4795
    end
-
 
4796
    else
-
 
4797
    begin
-
 
4798
      Inc(d, dinc2);
-
 
4799
      Inc(x, xinc2);
-
 
4800
      Inc(y, yinc2);
-
 
4801
    end;
-
 
4802
  end;
-
 
4803
end;
-
 
4804
 
-
 
4805
procedure TDirectDrawSurface.PokeLinePolar(x, y: Integer; angle, length: extended; Color: cardinal);
-
 
4806
var
-
 
4807
  xp, yp: Integer;
-
 
4808
begin
-
 
4809
  xp := round(sin(angle * pi / 180) * length) + x;
-
 
4810
  yp := round(cos(angle * pi / 180) * length) + y;
-
 
4811
  PokeLine(x, y, xp, yp, Color);
-
 
4812
end;
-
 
4813
 
-
 
4814
procedure TDirectDrawSurface.PokeBox(xs, ys, xd, yd: Integer; Color: cardinal);
-
 
4815
begin
-
 
4816
  pokeline(xs, ys, xd, ys, color);
-
 
4817
  pokeline(xs, ys, xs, yd, color);
-
 
4818
  pokeline(xd, ys, xd, yd, color);
-
 
4819
  pokeline(xs, yd, xd, yd, color);
-
 
4820
end;
-
 
4821
 
-
 
4822
procedure TDirectDrawSurface.PokeBlendPixel(const X, Y: Integer; aColor: cardinal; Alpha: byte);
-
 
4823
var
-
 
4824
  cr, cg, cb: byte;
-
 
4825
  ar, ag, ab: byte;
-
 
4826
begin
-
 
4827
  LoadRGB(aColor, ar, ag, ab);
-
 
4828
  LoadRGB(Pixel[x, y], cr, cg, cb);
-
 
4829
  Pixel[x, y] := SaveRGB((Alpha * (aR - cr) shr 8) + cr, // R alpha
-
 
4830
    (Alpha * (aG - cg) shr 8) + cg, // G alpha
-
 
4831
    (Alpha * (aB - cb) shr 8) + cb); // B alpha
-
 
4832
end;
-
 
4833
 
-
 
4834
function Conv24to16(Color: Integer): Word; register;
-
 
4835
asm
-
 
4836
  mov ecx,eax
-
 
4837
  shl eax,24
-
 
4838
  shr eax,27
-
 
4839
  shl eax,11
-
 
4840
  mov edx,ecx
-
 
4841
  shl edx,16
-
 
4842
  shr edx,26
-
 
4843
  shl edx,5
-
 
4844
  or eax,edx
-
 
4845
  mov edx,ecx
-
 
4846
  shl edx,8
-
 
4847
  shr edx,27
-
 
4848
  or eax,edx
-
 
4849
end;
-
 
4850
 
-
 
4851
procedure TDirectDrawSurface.PokeWuLine(X1, Y1, X2, Y2, aColor: Integer);
-
 
4852
var DeltaX, DeltaY, Loop, Start, Finish: Integer;
-
 
4853
  Dx, Dy, DyDx: Single; // fractional parts
-
 
4854
  Color16: DWord;
-
 
4855
begin
-
 
4856
  DeltaX := Abs(X2 - X1); // Calculate DeltaX and DeltaY for initialization
-
 
4857
  DeltaY := Abs(Y2 - Y1);
-
 
4858
  if (DeltaX = 0) or (DeltaY = 0) then
-
 
4859
  begin // straight lines
-
 
4860
    PokeLine(X1, Y1, X2, Y2, aColor);
-
 
4861
    Exit;
-
 
4862
  end;
-
 
4863
  if BitCount = 16 then
-
 
4864
    Color16 := Conv24to16(aColor)
-
 
4865
  else
-
 
4866
    Color16 := aColor;
-
 
4867
  if DeltaX > DeltaY then // horizontal or vertical
-
 
4868
  begin
-
 
4869
  { determine rise and run }
-
 
4870
    if Y2 > Y1 then DyDx := -(DeltaY / DeltaX)
-
 
4871
    else DyDx := DeltaY / DeltaX;
-
 
4872
    if X2 < X1 then
-
 
4873
    begin
-
 
4874
      Start := X2; // right to left
-
 
4875
      Finish := X1;
-
 
4876
      Dy := Y2;
-
 
4877
    end else
-
 
4878
    begin
-
 
4879
      Start := X1; // left to right
-
 
4880
      Finish := X2;
-
 
4881
      Dy := Y1;
-
 
4882
      DyDx := -DyDx; // inverse slope
-
 
4883
    end;
-
 
4884
    for Loop := Start to Finish do
-
 
4885
    begin
-
 
4886
      PokeBlendPixel(Loop, Trunc(Dy), Color16, Trunc((1 - Frac(Dy)) * 255));
-
 
4887
      PokeBlendPixel(Loop, Trunc(Dy) + 1, Color16, Trunc(Frac(Dy) * 255));
-
 
4888
      Dy := Dy + DyDx; // next point
-
 
4889
    end;
-
 
4890
  end else
-
 
4891
  begin
-
 
4892
   { determine rise and run }
-
 
4893
    if X2 > X1 then DyDx := -(DeltaX / DeltaY)
-
 
4894
    else DyDx := DeltaX / DeltaY;
-
 
4895
    if Y2 < Y1 then
-
 
4896
    begin
-
 
4897
      Start := Y2; // right to left
-
 
4898
      Finish := Y1;
-
 
4899
      Dx := X2;
-
 
4900
    end else
-
 
4901
    begin
-
 
4902
      Start := Y1; // left to right
-
 
4903
      Finish := Y2;
-
 
4904
      Dx := X1;
-
 
4905
      DyDx := -DyDx; // inverse slope
-
 
4906
    end;
-
 
4907
    for Loop := Start to Finish do
-
 
4908
    begin
-
 
4909
      PokeBlendPixel(Trunc(Dx), Loop, Color16, Trunc((1 - Frac(Dx)) * 255));
-
 
4910
      PokeBlendPixel(Trunc(Dx), Loop, Color16, Trunc(Frac(Dx) * 255));
-
 
4911
      Dx := Dx + DyDx; // next point
-
 
4912
    end;
-
 
4913
  end;
-
 
4914
end;
-
 
4915
 
-
 
4916
procedure TDirectDrawSurface.Noise(Oblast: TRect; Density: Byte);
-
 
4917
var
-
 
4918
  dx, dy: Integer;
-
 
4919
  Dens: byte;
-
 
4920
begin
-
 
4921
  {noise}
-
 
4922
  case Density of
-
 
4923
    0..2: Dens := 3;
-
 
4924
    255: Dens := 254;
-
 
4925
  else
-
 
4926
    Dens := Density;
-
 
4927
  end;
-
 
4928
  if Dens >= Oblast.Right then
-
 
4929
    Dens := Oblast.Right div 3;
-
 
4930
  dy := Oblast.Top;
-
 
4931
  while dy <= Oblast.Bottom do begin
-
 
4932
    dx := Oblast.Left;
-
 
4933
    while dx <= Oblast.Right do begin
-
 
4934
      inc(dx, random(dens));
-
 
4935
      if dx <= Oblast.Right then
-
 
4936
        Pixel[dx, dy] := not Pixel[dx, dy];
-
 
4937
    end;
-
 
4938
    inc(dy);
-
 
4939
  end;
-
 
4940
end;
-
 
4941
 
-
 
4942
function Conv16to24(Color: Word): Integer; register;
-
 
4943
asm
-
 
4944
 xor edx,edx
-
 
4945
 mov dx,ax
-
 
4946
 
-
 
4947
 mov eax,edx
-
 
4948
 shl eax,27
-
 
4949
 shr eax,8
-
 
4950
 
-
 
4951
 mov ecx,edx
-
 
4952
 shr ecx,5
-
 
4953
 shl ecx,26
-
 
4954
 shr ecx,16
-
 
4955
 or eax,ecx
-
 
4956
 
-
 
4957
 mov ecx,edx
-
 
4958
 shr ecx,11
-
 
4959
 shl ecx,27
-
 
4960
 shr ecx,24
-
 
4961
 or eax,ecx
-
 
4962
end;
-
 
4963
 
-
 
4964
procedure GetRGB(Color: cardinal; var R, G, B: Byte); {$IFDEF VER9UP}inline; {$ENDIF}
-
 
4965
begin
-
 
4966
  R := Color;
-
 
4967
  G := Color shr 8;
-
 
4968
  B := Color shr 16;
-
 
4969
end;
-
 
4970
 
-
 
4971
procedure TDirectDrawSurface.LoadRGB(Color: cardinal; var R, G, B: Byte);
-
 
4972
var grB: Byte;
-
 
4973
begin
-
 
4974
  grB := 1;
-
 
4975
  if FLockSurfaceDesc.ddpfPixelFormat.dwGBitMask = 2016 then grB := 0; // 565
-
 
4976
  case BitCount of
-
 
4977
    15, 16: begin
-
 
4978
        R := (color shr (11 - grB)) shl 3;
-
 
4979
        if grB = 0 then
-
 
4980
          G := ((color and 2016) shr 5) shl 2
-
 
4981
        else
-
 
4982
          G := ((color and 992) shr 5) shl 3;
-
 
4983
        B := (color and 31) shl 3;
-
 
4984
      end;
-
 
4985
  else
-
 
4986
    GetRGB(Color, R, G, B);
-
 
4987
  end;
-
 
4988
end;
-
 
4989
 
-
 
4990
function TDirectDrawSurface.SaveRGB(const R, G, B: Byte): cardinal;
-
 
4991
begin
-
 
4992
  case BitCount of
-
 
4993
    15, 16: begin
-
 
4994
        Result := Conv24to16(RGB(R, G, B));
-
 
4995
      end;
-
 
4996
  else
-
 
4997
    Result := RGB(R, G, B);
-
 
4998
  end;
-
 
4999
end;
-
 
5000
 
-
 
5001
procedure TDirectDrawSurface.Blur;
-
 
5002
var
-
 
5003
  x, y, tr, tg, tb: Integer;
-
 
5004
  r, g, b: byte;
-
 
5005
begin
-
 
5006
  for y := 1 to GetHeight - 1 do
-
 
5007
    for x := 1 to GetWidth - 1 do begin
-
 
5008
      LoadRGB(peek(x, y), r, g, b);
-
 
5009
      tr := r;
-
 
5010
      tg := g;
-
 
5011
      tb := b;
-
 
5012
      LoadRGB(peek(x, y + 1), r, g, b);
-
 
5013
      Inc(tr, r);
-
 
5014
      Inc(tg, g);
-
 
5015
      Inc(tb, b);
-
 
5016
      LoadRGB(peek(x, y - 1), r, g, b);
-
 
5017
      Inc(tr, r);
-
 
5018
      Inc(tg, g);
-
 
5019
      Inc(tb, b);
-
 
5020
      LoadRGB(peek(x - 1, y), r, g, b);
-
 
5021
      Inc(tr, r);
-
 
5022
      Inc(tg, g);
-
 
5023
      Inc(tb, b);
-
 
5024
      LoadRGB(peek(x + 1, y), r, g, b);
-
 
5025
      Inc(tr, r);
-
 
5026
      Inc(tg, g);
-
 
5027
      Inc(tb, b);
-
 
5028
      tr := tr shr 2;
-
 
5029
      tg := tg shr 2;
-
 
5030
      tb := tb shr 2;
-
 
5031
      Poke(x, y, savergb(tr, tg, tb));
-
 
5032
    end;
-
 
5033
end;
-
 
5034
 
-
 
5035
procedure TDirectDrawSurface.PokeCircle(X, Y, Radius, Color: Integer);
-
 
5036
var
-
 
5037
  a, af, b, bf, c,
-
 
5038
    target, r2: Integer;
-
 
5039
begin
-
 
5040
  Target := 0;
-
 
5041
  A := Radius;
-
 
5042
  B := 0;
-
 
5043
  R2 := Sqr(Radius);
-
 
5044
 
-
 
5045
  while a >= B do
-
 
5046
  begin
-
 
5047
    b := Round(Sqrt(R2 - Sqr(A)));
-
 
5048
    c := target; target := b; b := c;
-
 
5049
    while B < Target do
-
 
5050
    begin
-
 
5051
      Af := (120 * a) div 100;
-
 
5052
      Bf := (120 * b) div 100;
-
 
5053
      pixel[x + af, y + b] := color;
-
 
5054
      pixel[x + bf, y + a] := color;
-
 
5055
      pixel[x - af, y + b] := color;
-
 
5056
      pixel[x - bf, y + a] := color;
-
 
5057
      pixel[x - af, y - b] := color;
-
 
5058
      pixel[x - bf, y - a] := color;
-
 
5059
      pixel[x + af, y - b] := color;
-
 
5060
      pixel[x + bf, y - a] := color;
-
 
5061
      B := B + 1;
-
 
5062
    end;
-
 
5063
    A := A - 1;
-
 
5064
  end;
-
 
5065
end;
-
 
5066
 
-
 
5067
function RGBToBGR(Color: cardinal): cardinal;
-
 
5068
begin
-
 
5069
  result := (LoByte(LoWord(Color)) shr 3 shl 11) or // Red
-
 
5070
    (HiByte((Color)) shr 2 shl 5) or // Green
-
 
5071
    (LoByte(HiWord(Color)) shr 3); // Blue
-
 
5072
end;
-
 
5073
 
-
 
5074
procedure TDirectDrawSurface.PokeVLine(x, y1, y2: Integer; Color: cardinal);
-
 
5075
var
-
 
5076
  y: Integer;
-
 
5077
  NColor: cardinal;
-
 
5078
  r, g, b: byte;
-
 
5079
begin
-
 
5080
  if y1 < 0 then y1 := 0;
-
 
5081
  if y2 >= Height then y2 := Height - 1;
-
 
5082
  GetRGB(Color, r, g, b);
-
 
5083
  NColor := RGBToBGR(rgb(r, g, b));
-
 
5084
  for y := y1 to y2 do
-
 
5085
  begin
-
 
5086
    pixel[x, y] := NColor;
-
 
5087
  end;
-
 
5088
end;
-
 
5089
 
-
 
5090
procedure TDirectDrawSurface.PokeFilledEllipse(exc, eyc, ea, eb, color: Integer);
-
 
5091
var x, y: Integer; aa, aa2, bb, bb2, d, dx, dy: LongInt;
-
 
5092
begin
-
 
5093
  x := 0;
-
 
5094
  y := eb;
-
 
5095
  aa := LongInt(ea) * ea;
-
 
5096
  aa2 := 2 * aa;
-
 
5097
  bb := LongInt(eb) * eb;
-
 
5098
  bb2 := 2 * bb;
-
 
5099
  d := bb - aa * eb + aa div 4;
-
 
5100
  dx := 0;
-
 
5101
  dy := aa2 * eb;
-
 
5102
  PokevLine(exc, eyc - y, eyc + y, color);
-
 
5103
  while (dx < dy) do begin
-
 
5104
    if (d > 0) then begin
-
 
5105
      dec(y); dec(dy, aa2); dec(d, dy);
-
 
5106
    end;
-
 
5107
    inc(x); inc(dx, bb2); inc(d, bb + dx);
-
 
5108
    PokevLine(exc - x, eyc - y, eyc + y, color);
-
 
5109
    PokevLine(exc + x, eyc - y, eyc + y, color);
-
 
5110
  end;
-
 
5111
  inc(d, (3 * (aa - bb) div 2 - (dx + dy)) div 2);
-
 
5112
  while (y >= 0) do begin
-
 
5113
    if (d < 0) then begin
-
 
5114
      inc(x); inc(dx, bb2); inc(d, bb + dx);
-
 
5115
      PokevLine(exc - x, eyc - y, eyc + y, color);
-
 
5116
      PokevLine(exc + x, eyc - y, eyc + y, color);
-
 
5117
    end;
-
 
5118
    dec(y); dec(dy, aa2); inc(d, aa - dy);
-
 
5119
  end;
-
 
5120
end;
-
 
5121
 
-
 
5122
procedure TDirectDrawSurface.DoRotate(cent1, cent2, angle: Integer; coord1, coord2: Real; Color: word);
-
 
5123
var coord1t, coord2t: Real;
-
 
5124
  c1, c2: Integer;
-
 
5125
begin
-
 
5126
  coord1t := coord1 - cent1;
-
 
5127
  coord2t := coord2 - cent2;
-
 
5128
  coord1 := coord1t * cos(angle * pi / 180) - coord2t * sin(angle * pi / 180);
-
 
5129
  coord2 := coord1t * sin(angle * pi / 180) + coord2t * cos(angle * pi / 180);
-
 
5130
  coord1 := coord1 + cent1;
-
 
5131
  coord2 := coord2 + cent2;
-
 
5132
  c1 := round(coord1);
-
 
5133
  c2 := round(coord2);
-
 
5134
  pixel[c1, c2] := Color;
-
 
5135
end;
-
 
5136
 
-
 
5137
procedure TDirectDrawSurface.PokeEllipse(exc, eyc, ea, eb, angle, Color: Integer);
-
 
5138
var
-
 
5139
  elx, ely: Integer;
-
 
5140
  aa, aa2, bb, bb2, d, dx, dy: LongInt;
-
 
5141
  x, y: real;
-
 
5142
begin
-
 
5143
  elx := 0;
-
 
5144
  ely := eb;
-
 
5145
  aa := LongInt(ea) * ea;
-
 
5146
  aa2 := 2 * aa;
-
 
5147
  bb := LongInt(eb) * eb;
-
 
5148
  bb2 := 2 * bb;
-
 
5149
  d := bb - aa * eb + aa div 4;
-
 
5150
  dx := 0;
-
 
5151
  dy := aa2 * eb;
-
 
5152
  x := exc;
-
 
5153
  y := eyc - ely;
-
 
5154
  dorotate(exc, eyc, angle, x, y, Color);
-
 
5155
  x := exc;
-
 
5156
  y := eyc + ely;
-
 
5157
  dorotate(exc, eyc, angle, x, y, Color);
-
 
5158
  x := exc - ea;
-
 
5159
  y := eyc;
-
 
5160
  dorotate(exc, eyc, angle, x, y, Color);
-
 
5161
  x := exc + ea;
-
 
5162
  y := eyc;
-
 
5163
  dorotate(exc, eyc, angle, x, y, Color);
-
 
5164
  while (dx < dy) do begin
-
 
5165
    if (d > 0) then begin Dec(ely); Dec(dy, aa2); Dec(d, dy); end;
-
 
5166
    Inc(elx); Inc(dx, bb2); Inc(d, bb + dx);
-
 
5167
    x := exc + elx; y := eyc + ely;
-
 
5168
    dorotate(exc, eyc, angle, x, y, Color);
-
 
5169
    x := exc - elx; y := eyc + ely;
-
 
5170
    dorotate(exc, eyc, angle, x, y, Color);
-
 
5171
    x := exc + elx; y := eyc - ely;
-
 
5172
    dorotate(exc, eyc, angle, x, y, Color);
-
 
5173
    x := exc - elx; y := eyc - ely;
-
 
5174
    dorotate(exc, eyc, angle, x, y, Color);
-
 
5175
  end;
-
 
5176
  Inc(d, (3 * (aa - bb) div 2 - (dx + dy)) div 2);
-
 
5177
  while (ely > 0) do begin
-
 
5178
    if (d < 0) then begin Inc(elx); Inc(dx, bb2); Inc(d, bb + dx); end;
-
 
5179
    Dec(ely); Dec(dy, aa2); Inc(d, aa - dy);
-
 
5180
    x := exc + elx; y := eyc + ely;
-
 
5181
    dorotate(exc, eyc, angle, x, y, Color);
-
 
5182
    x := exc - elx; y := eyc + ely;
-
 
5183
    dorotate(exc, eyc, angle, x, y, Color);
-
 
5184
    x := exc + elx; y := eyc - ely;
-
 
5185
    dorotate(exc, eyc, angle, x, y, Color);
-
 
5186
    x := exc - elx; y := eyc - ely;
-
 
5187
    dorotate(exc, eyc, angle, x, y, Color);
-
 
5188
  end;
-
 
5189
end;
-
 
5190
 
-
 
5191
procedure TDirectDrawSurface.MirrorFlip(Value: TRenderMirrorFlipSet);
-
 
5192
begin
-
 
5193
  if AsSigned(D2D) and D2D.CanUseD2D and (D2D.FDDraw.Surface = Self) then
-
 
5194
    D2D.MirrorFlip := Value;
-
 
5195
end;
-
 
5196
 
2713
{  TDXDrawDisplayMode  }
5197
{  TDXDrawDisplayMode  }
2714
 
5198
 
2715
function TDXDrawDisplayMode.GetBitCount: Integer;
5199
function TDXDrawDisplayMode.GetBitCount: Integer;
2716
begin
5200
begin
2717
  Result := FSurfaceDesc.ddpfPixelFormat.dwRGBBitCount;
5201
  Result := FSurfaceDesc.ddpfPixelFormat.dwRGBBitCount;
Line 2734... Line 5218...
2734
  inherited Create;
5218
  inherited Create;
2735
  FDXDraw := ADXDraw;
5219
  FDXDraw := ADXDraw;
2736
  FModes := TCollection.Create(TDXDrawDisplayMode);
5220
  FModes := TCollection.Create(TDXDrawDisplayMode);
2737
  FWidth := 640;
5221
  FWidth := 640;
2738
  FHeight := 480;
5222
  FHeight := 480;
2739
  FBitCount := 8;
5223
  FBitCount := 16;
2740
  FFixedBitCount := True;
5224
  FFixedBitCount := False; //True;
2741
  FFixedRatio := True;
5225
  FFixedRatio := True;
2742
  FFixedSize := False;
5226
  FFixedSize := True; //False;
2743
end;
5227
end;
2744
 
5228
 
2745
destructor TDXDrawDisplay.Destroy;
5229
destructor TDXDrawDisplay.Destroy;
2746
begin
5230
begin
2747
  FModes.Free;
5231
  FModes.Free;
Line 2750... Line 5234...
2750
 
5234
 
2751
procedure TDXDrawDisplay.Assign(Source: TPersistent);
5235
procedure TDXDrawDisplay.Assign(Source: TPersistent);
2752
begin
5236
begin
2753
  if Source is TDXDrawDisplay then
5237
  if Source is TDXDrawDisplay then
2754
  begin
5238
  begin
2755
    if Source<>Self then
5239
    if Source <> Self then
2756
    begin
5240
    begin
2757
      FBitCount := TDXDrawDisplay(Source).BitCount;
5241
      FBitCount := TDXDrawDisplay(Source).BitCount;
2758
      FHeight := TDXDrawDisplay(Source).Height;
5242
      FHeight := TDXDrawDisplay(Source).Height;
2759
      FWidth := TDXDrawDisplay(Source).Width;
5243
      FWidth := TDXDrawDisplay(Source).Width;
2760
 
5244
 
Line 2766... Line 5250...
2766
    inherited Assign(Source);
5250
    inherited Assign(Source);
2767
end;
5251
end;
2768
 
5252
 
2769
function TDXDrawDisplay.GetCount: Integer;
5253
function TDXDrawDisplay.GetCount: Integer;
2770
begin
5254
begin
2771
  if FModes.Count=0 then
5255
  if FModes.Count = 0 then
2772
    LoadDisplayModes;
5256
    LoadDisplayModes;
2773
  Result := FModes.Count;
5257
  Result := FModes.Count;
2774
end;
5258
end;
2775
 
5259
 
2776
function TDXDrawDisplay.GetMode: TDXDrawDisplayMode;
5260
function TDXDrawDisplay.GetMode: TDXDrawDisplayMode;
2777
var
5261
var
2778
  i: Integer;
5262
  i: Integer;
2779
  ddsd: TDDSurfaceDesc;
5263
  ddsd: {$IFDEF D3D_deprecated}TDDSurfaceDesc{$ELSE}TDDSurfaceDesc2{$ENDIF};
2780
begin
5264
begin
2781
  Result := nil;
5265
  Result := nil;
2782
  if FDXDraw.DDraw<>nil then
5266
  if FDXDraw.DDraw <> nil then
2783
  begin
5267
  begin
2784
    ddsd := FDXDraw.DDraw.DisplayMode;
5268
    ddsd := FDXDraw.DDraw.DisplayMode;
2785
    with ddsd do
5269
    with ddsd do
2786
      i := IndexOf(dwWidth, dwHeight, ddpfPixelFormat.dwRGBBitCount);
5270
      i := IndexOf(dwWidth, dwHeight, ddpfPixelFormat.dwRGBBitCount);
2787
    if i<>-1 then
5271
    if i <> -1 then
2788
      Result := Modes[i];
5272
      Result := Modes[i];
2789
  end;
5273
  end;
2790
  if Result=nil then
5274
  if Result = nil then
2791
    raise EDirectDrawError.Create(SDisplayModeCannotAcquired);
5275
    raise EDirectDrawError.Create(SDisplayModeCannotAcquired);
2792
end;
5276
end;
2793
 
5277
 
2794
function TDXDrawDisplay.GetMode2(Index: Integer): TDXDrawDisplayMode;
5278
function TDXDrawDisplay.GetMode2(Index: Integer): TDXDrawDisplayMode;
2795
begin
5279
begin
2796
  if FModes.Count=0 then
5280
  if FModes.Count = 0 then
2797
    LoadDisplayModes;
5281
    LoadDisplayModes;
2798
  Result := TDXDrawDisplayMode(FModes.Items[Index]);
5282
  Result := TDXDrawDisplayMode(FModes.Items[Index]);
2799
end;
5283
end;
2800
 
5284
 
2801
function TDXDrawDisplay.IndexOf(Width, Height, BitCount: Integer): Integer;
5285
function TDXDrawDisplay.IndexOf(Width, Height, BitCount: Integer): Integer;
2802
var
5286
var
2803
  i: Integer;
5287
  i: Integer;
2804
begin
5288
begin
2805
  Result := -1;
5289
  Result := -1;
2806
  for i:=0 to Count-1 do
5290
  for i := 0 to Count - 1 do
2807
    if (Modes[i].Width=Width) and (Modes[i].Height=Height) and (Modes[i].BitCount=BitCount) then
5291
    if (Modes[i].Width = Width) and (Modes[i].Height = Height) and (Modes[i].BitCount = BitCount) then
2808
    begin
5292
    begin
2809
      Result := i;
5293
      Result := i;
2810
      Exit;
5294
      Exit;
2811
    end;
5295
    end;
2812
end;
5296
end;
Line 2821... Line 5305...
2821
    Result := DDENUMRET_OK;
5305
    Result := DDENUMRET_OK;
2822
  end;
5306
  end;
2823
 
5307
 
2824
  function Compare(Item1, Item2: TDXDrawDisplayMode): Integer;
5308
  function Compare(Item1, Item2: TDXDrawDisplayMode): Integer;
2825
  begin
5309
  begin
2826
    if Item1.Width<>Item2.Width then
5310
    if Item1.Width <> Item2.Width then
2827
      Result := Item1.Width-Item2.Width
5311
      Result := Item1.Width - Item2.Width
2828
    else if Item1.Height<>Item2.Height then
5312
    else if Item1.Height <> Item2.Height then
2829
      Result := Item1.Height-Item2.Height
5313
      Result := Item1.Height - Item2.Height
2830
    else
5314
    else
2831
      Result := Item1.BitCount-Item2.BitCount;
5315
      Result := Item1.BitCount - Item2.BitCount;
2832
  end;
5316
  end;
2833
 
5317
 
2834
var
5318
var
2835
  DDraw: TDirectDraw;
5319
  DDraw: TDirectDraw;
2836
  TempList: TList;
5320
  TempList: TList;
2837
  i: Integer;
5321
  i: Integer;
2838
begin
5322
begin
2839
  FModes.Clear;
5323
  FModes.Clear;
2840
 
5324
 
2841
  if FDXDraw.DDraw<>nil then
5325
  if FDXDraw.DDraw <> nil then
2842
  begin
5326
  begin
2843
    FDXDraw.DDraw.DXResult := FDXDraw.DDraw.IDraw.EnumDisplayModes(0, PDDSurfaceDesc(nil)^,
5327
    FDXDraw.DDraw.DXResult := FDXDraw.DDraw.{$IFDEF D3D_deprecated}IDraw{$ELSE}IDraw7{$ENDIF}
-
 
5328
      .EnumDisplayModes(0, {$IFDEF D3D_deprecated}PDDSurfaceDesc{$ELSE}PDDSurfaceDesc2{$ENDIF}(nil),
2844
      FModes, @EnumDisplayModesProc);
5329
      FModes, @EnumDisplayModesProc);
2845
  end else
5330
  end else
2846
  begin
5331
  begin
2847
    DDraw := TDirectDraw.Create(PGUID(FDXDraw.FDriver));
5332
    DDraw := TDirectDraw.Create(PGUID(FDXDraw.FDriver));
2848
    try
5333
    try
-
 
5334
      DDraw.{$IFDEF D3D_deprecated}IDraw{$ELSE}IDraw7{$ENDIF}
2849
      DDraw.IDraw.EnumDisplayModes(0, PDDSurfaceDesc(nil)^, FModes, @EnumDisplayModesProc);
5335
      .EnumDisplayModes(0, {$IFDEF D3D_deprecated}PDDSurfaceDesc{$ELSE}PDDSurfaceDesc2{$ENDIF}(nil),
-
 
5336
      FModes, @EnumDisplayModesProc);
2850
    finally
5337
    finally
2851
      DDraw.Free;
5338
      DDraw.Free;
2852
    end;
5339
    end;
2853
  end;
5340
  end;
2854
               
-
 
-
 
5341
 
2855
  TempList := TList.Create;
5342
  TempList := TList.Create;
2856
  try
5343
  try
2857
    for i:=0 to FModes.Count-1 do
5344
    for i := 0 to FModes.Count - 1 do
2858
      TempList.Add(FModes.Items[i]);
5345
      TempList.Add(FModes.Items[i]);
2859
    TempList.Sort(@Compare);
5346
    TempList.Sort(@Compare);
2860
                             
-
 
-
 
5347
 
2861
    for i:=FModes.Count-1 downto 0 do
5348
    for i := FModes.Count - 1 downto 0 do
2862
      TDXDrawDisplayMode(TempList[i]).Index := i;
5349
      TDXDrawDisplayMode(TempList[i]).Index := i;
2863
  finally
5350
  finally
2864
    TempList.Free;
5351
    TempList.Free;
2865
  end;
5352
  end;
2866
end;
5353
end;
2867
 
5354
 
2868
function TDXDrawDisplay.SetSize(AWidth, AHeight, ABitCount: Integer): Boolean;
5355
function TDXDrawDisplay.SetSize(AWidth, AHeight, ABitCount{$IFNDEF D3D_deprecated}, ARefreshRate, AFlags{$ENDIF}: Integer): Boolean;
2869
begin
5356
begin
2870
  Result := False;
5357
  Result := False;
2871
  if FDXDraw.DDraw<>nil then
5358
  if FDXDraw.DDraw <> nil then
2872
  begin
5359
  begin
2873
    FDXDraw.DDraw.DXResult := FDXDraw.DDraw.IDraw.SetDisplayMode(AWidth, AHeight, ABitCount);
5360
    FDXDraw.DDraw.DXResult := FDXDraw.DDraw.{$IFDEF D3D_deprecated}IDraw{$ELSE}IDraw7{$ENDIF}
-
 
5361
      .SetDisplayMode(AWidth, AHeight, ABitCount{$IFNDEF D3D_deprecated}, ARefreshRate, AFlags{$ENDIF});
2874
    Result := FDXDraw.DDraw.DXResult=DD_OK;
5362
    Result := FDXDraw.DDraw.DXResult = DD_OK;
2875
 
5363
 
2876
    if Result then
5364
    if Result then
2877
    begin
5365
    begin
2878
      FWidth := AWidth;
5366
      FWidth := AWidth;
2879
      FHeight := AHeight;
5367
      FHeight := AHeight;
Line 2882... Line 5370...
2882
  end;
5370
  end;
2883
end;
5371
end;
2884
 
5372
 
2885
function TDXDrawDisplay.DynSetSize(AWidth, AHeight, ABitCount: Integer): Boolean;
5373
function TDXDrawDisplay.DynSetSize(AWidth, AHeight, ABitCount: Integer): Boolean;
2886
 
5374
 
-
 
5375
  {$IFNDEF D3D_deprecated}
-
 
5376
  function GetDefaultRefreshRate: Integer;
-
 
5377
  begin
-
 
5378
    Result := 60;
-
 
5379
  end;
-
 
5380
  {$ENDIF}
-
 
5381
 
2887
  function TestBitCount(BitCount, ABitCount: Integer): Boolean;
5382
  function TestBitCount(BitCount, ABitCount: Integer): Boolean;
2888
  begin
5383
  begin
2889
    if (BitCount>8) and (ABitCount>8) then
5384
    if (BitCount > 8) and (ABitCount > 8) then
2890
    begin
5385
    begin
2891
      Result := True;
5386
      Result := True;
2892
    end else
5387
    end else
2893
    begin
5388
    begin
2894
      Result := BitCount>=ABitCount;
5389
      Result := BitCount >= ABitCount;
2895
    end;
5390
    end;
2896
  end;
5391
  end;
2897
 
5392
 
2898
  function SetSize2(Ratio: Boolean): Boolean;
5393
  function SetSize2(Ratio: Boolean): Boolean;
2899
  var
5394
  var
2900
    DWidth, DHeight, DBitCount, i: Integer;
5395
    DWidth, DHeight, DBitCount{$IFNDEF D3D_deprecated}, DRRate, DFlags{$ENDIF}, i: Integer;
2901
    Flag: Boolean;
5396
    Flag: Boolean;
2902
  begin
5397
  begin
2903
    Result := False;
5398
    Result := False;
2904
 
5399
 
2905
    DWidth := Maxint;
5400
    DWidth := Maxint;
2906
    DHeight := Maxint;
5401
    DHeight := Maxint;
2907
    DBitCount := ABitCount;
5402
    DBitCount := ABitCount;
-
 
5403
    {$IFNDEF D3D_deprecated}
-
 
5404
    DRRate := GetDefaultRefreshRate;
-
 
5405
    DFlags := 0;
2908
 
5406
    {$ENDIF}
2909
    Flag := False;
5407
    Flag := False;
2910
    for i:=0 to Count-1 do
5408
    for i := 0 to Count - 1 do
2911
      with Modes[i] do
5409
      with Modes[i] do
2912
      begin
5410
      begin
2913
        if ((DWidth>=Width) and (DHeight>=Width) and
5411
        if ((DWidth >= Width) and (DHeight >= Width) and
2914
          ((not Ratio) or (Width/Height=AWidth/AHeight)) and
5412
          ((not Ratio) or (Width / Height = AWidth / AHeight)) and
2915
          ((FFixedSize and (Width=AWidth) and (Height=Height)) or
5413
          ((FFixedSize and (Width = AWidth) and (Height = Height)) or
2916
          ((not FFixedSize) and (Width>=AWidth) and (Height>=AHeight))) and
5414
          ((not FFixedSize) and (Width >= AWidth) and (Height >= AHeight))) and
2917
 
5415
 
2918
          ((FFixedBitCount and (BitCount=ABitCount)) or
5416
          ((FFixedBitCount and (BitCount = ABitCount)) or
2919
          ((not FFixedBitCount) and TestBitCount(BitCount, ABitCount)))) then
5417
          ((not FFixedBitCount) and TestBitCount(BitCount, ABitCount)))) then
2920
        begin
5418
        begin
2921
          DWidth := Width;
5419
          DWidth := Width;
2922
          DHeight := Height;
5420
          DHeight := Height;
2923
          DBitCount := BitCount;
5421
          DBitCount := BitCount;
Line 2925... Line 5423...
2925
        end;
5423
        end;
2926
      end;
5424
      end;
2927
 
5425
 
2928
    if Flag then
5426
    if Flag then
2929
    begin
5427
    begin
2930
      if (DBitCount<>ABitCount) then
5428
      if (DBitCount <> ABitCount) then
2931
      begin
5429
      begin
2932
        if IndexOf(DWidth, DHEight, ABitCount)<>-1 then
5430
        if IndexOf(DWidth, DHEight, ABitCount) <> -1 then
2933
          DBitCount := ABitCount;
5431
          DBitCount := ABitCount;
2934
      end;
5432
      end;
2935
 
5433
 
2936
      Result := SetSize(DWidth, DHeight, DBitCount);
5434
      Result := SetSize(DWidth, DHeight, DBitCount{$IFNDEF D3D_deprecated}, DRRate, DFlags{$ENDIF});
2937
    end;
5435
    end;
2938
  end;
5436
  end;
2939
 
5437
 
2940
begin
5438
begin
2941
  Result := False;
5439
  Result := False;
2942
 
5440
 
2943
  if (AWidth<=0) or (AHeight<=0) or (not (ABitCount in [8, 16, 24, 32])) then Exit;
5441
  if (AWidth <= 0) or (AHeight <= 0) or (not (ABitCount in [8, 16, 24, 32])) then Exit;
2944
 
5442
 
2945
  {  The change is attempted by the size of default.  }
5443
  {  The change is attempted by the size of default.  }
2946
  if SetSize(AWidth, AHeight, ABitCount) then
5444
  if SetSize(AWidth, AHeight, ABitCount{$IFNDEF D3D_deprecated}, GetDefaultRefreshRate, 0{$ENDIF}) then
2947
  begin
5445
  begin
2948
    Result := True;
5446
    Result := True;
2949
    Exit;
5447
    Exit;
2950
  end;
5448
  end;
2951
 
5449
 
Line 2999... Line 5497...
2999
  end;
5497
  end;
3000
end;
5498
end;
3001
 
5499
 
3002
procedure FreeZBufferSurface(Surface: TDirectDrawSurface; var ZBuffer: TDirectDrawSurface);
5500
procedure FreeZBufferSurface(Surface: TDirectDrawSurface; var ZBuffer: TDirectDrawSurface);
3003
begin
5501
begin
3004
  if ZBuffer<>nil then
5502
  if ZBuffer <> nil then
3005
  begin
5503
  begin
3006
    if (Surface.IDDSurface<>nil) and (ZBuffer.IDDSurface<>nil) then
5504
    if (Surface.{$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF} <> nil) and (ZBuffer.{$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF} <> nil) then
3007
      Surface.ISurface.DeleteAttachedSurface(0, ZBuffer.IDDSurface);
5505
      Surface.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}.DeleteAttachedSurface(0, ZBuffer.{$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF});
3008
    ZBuffer.Free; ZBuffer := nil;
5506
    ZBuffer.Free; ZBuffer := nil;
3009
  end;
5507
  end;
3010
end;
5508
end;
3011
 
5509
 
3012
type
5510
type
3013
  TInitializeDirect3DOption = (idoSelectDriver, idoOptimizeDisplayMode,
5511
  TInitializeDirect3DOption = (idoSelectDriver, idoOptimizeDisplayMode,
3014
    idoHardware, idoRetainedMode, idoZBuffer);
5512
    idoHardware, {$IFDEF D3DRM}idoRetainedMode,{$ENDIF} idoZBuffer);
3015
 
5513
 
3016
  TInitializeDirect3DOptions = set of TInitializeDirect3DOption;
5514
  TInitializeDirect3DOptions = set of TInitializeDirect3DOption;
3017
 
5515
 
3018
procedure Direct3DInitializing(Options: TInitializeDirect3DOptions;
5516
procedure Direct3DInitializing(Options: TInitializeDirect3DOptions;
3019
  var BitCount: Integer; var Driver: PGUID; var DriverGUID: TGUID);
5517
  var BitCount: Integer; var Driver: PGUID; var DriverGUID: TGUID{$IFNDEF D3D_deprecated}; var D3DDeviceTypeSet: TD3DDeviceTypeSet{$ENDIF});
3020
type
5518
type
3021
  PDirect3DInitializingRecord = ^TDirect3DInitializingRecord;
5519
  PDirect3DInitializingRecord = ^TDirect3DInitializingRecord;
3022
  TDirect3DInitializingRecord = record
5520
  TDirect3DInitializingRecord = record
3023
    Options: TInitializeDirect3DOptions;
5521
    Options: TInitializeDirect3DOptions;
3024
    Driver: ^PGUID;
5522
    Driver: ^PGUID;
Line 3026... Line 5524...
3026
    BitCount: Integer;
5524
    BitCount: Integer;
3027
 
5525
 
3028
    Flag: Boolean;
5526
    Flag: Boolean;
3029
    DriverCaps: TDDCaps;
5527
    DriverCaps: TDDCaps;
3030
    HELCaps: TDDCaps;
5528
    HELCaps: TDDCaps;
-
 
5529
    {$IFDEF D3D_deprecated}
3031
    HWDeviceDesc: TD3DDeviceDesc;
5530
    HWDeviceDesc: TD3DDeviceDesc;
3032
    HELDeviceDesc: TD3DDeviceDesc;
5531
    HELDeviceDesc: TD3DDeviceDesc;
3033
    DeviceDesc: TD3DDeviceDesc;
5532
    DeviceDesc: TD3DDeviceDesc;
3034
 
5533
    {$ELSE}
-
 
5534
    DeviceDesc: TD3DDeviceDesc7;
-
 
5535
    {$ENDIF}
3035
    D3DFlag: Boolean;
5536
    D3DFlag: Boolean;
-
 
5537
    {$IFDEF D3D_deprecated}
3036
    HWDeviceDesc2: TD3DDeviceDesc;
5538
    HWDeviceDesc2: TD3DDeviceDesc;
3037
    HELDeviceDesc2: TD3DDeviceDesc;
5539
    HELDeviceDesc2: TD3DDeviceDesc;
3038
    DeviceDesc2: TD3DDeviceDesc;
5540
    DeviceDesc2: TD3DDeviceDesc;
-
 
5541
    {$ELSE}
-
 
5542
    DeviceDesc2: TD3DDeviceDesc7;
-
 
5543
    {$ENDIF}
3039
  end;
5544
  end;
3040
 
5545
 
-
 
5546
  {$IFDEF D3D_deprecated}
3041
  function EnumDeviceCallBack(const lpGuid: TGUID; lpDeviceDescription, lpDeviceName: PChar;
5547
  function EnumDeviceCallBack(lpGuid: PGUID; // nil for the default device
-
 
5548
      lpDeviceDescription: PAnsiChar; lpDeviceName: PAnsiChar;
-
 
5549
      var lpD3DHWDeviceDesc: TD3DDeviceDesc;
3042
    const lpD3DHWDeviceDesc, lpD3DHELDeviceDesc: TD3DDeviceDesc;
5550
      var lpD3DHELDeviceDesc: TD3DDeviceDesc;
3043
    rec: PDirect3DInitializingRecord): HRESULT; stdcall;
5551
      rec: PDirect3DInitializingRecord) : HResult; stdcall;
3044
 
5552
 
3045
    procedure UseThisDevice;
5553
    procedure UseThisDevice;
3046
    begin
5554
    begin
3047
      rec.D3DFlag := True;
5555
      rec.D3DFlag := True;
3048
      rec.HWDeviceDesc2 := lpD3DHWDeviceDesc;
5556
      rec.HWDeviceDesc2 := lpD3DHWDeviceDesc;
Line 3051... Line 5559...
3051
    end;
5559
    end;
3052
 
5560
 
3053
  begin
5561
  begin
3054
    Result := D3DENUMRET_OK;
5562
    Result := D3DENUMRET_OK;
3055
 
5563
 
3056
    if lpD3DHWDeviceDesc.dcmColorModel=0 then Exit;
5564
    if lpD3DHWDeviceDesc.dcmColorModel = 0 then Exit;
3057
 
5565
 
3058
    if idoOptimizeDisplayMode in rec.Options then
5566
    if idoOptimizeDisplayMode in rec.Options then
3059
    begin
5567
    begin
3060
      if (lpD3DHWDeviceDesc.dwDeviceRenderBitDepth and (DDBD_16 or DDBD_24 or DDBD_32))=0 then Exit;
5568
      if (lpD3DHWDeviceDesc.dwDeviceRenderBitDepth and (DDBD_16 or DDBD_24 or DDBD_32)) = 0 then Exit;
-
 
5569
    end
3061
    end else
5570
    else
3062
    begin
5571
    begin
3063
      if (lpD3DHWDeviceDesc.dwDeviceRenderBitDepth and BPPToDDBD(rec.BitCount))=0 then Exit;
5572
      if (lpD3DHWDeviceDesc.dwDeviceRenderBitDepth and BPPToDDBD(rec.BitCount)) = 0 then Exit;
3064
    end;
5573
    end;
3065
 
5574
 
3066
    UseThisDevice;
5575
    UseThisDevice;
3067
  end;
5576
  end;
-
 
5577
  {$ELSE}
-
 
5578
  function EnumDeviceCallBack(lpDeviceDescription: PAnsiChar; lpDeviceName: PAnsiChar;
-
 
5579
      const lpD3DDeviceDesc: TD3DDeviceDesc7; rec: PDirect3DInitializingRecord) : HResult; stdcall;
-
 
5580
  begin
-
 
5581
    Result := D3DENUMRET_OK;
-
 
5582
 
-
 
5583
    maxVideoBlockSize := Min(lpD3DDeviceDesc.dwMaxTextureWidth, lpD3DDeviceDesc.dwMaxTextureHeight);
-
 
5584
    SurfaceDivWidth := lpD3DDeviceDesc.dwMaxTextureWidth;
-
 
5585
    SurfaceDivHeight := lpD3DDeviceDesc.dwMaxTextureHeight;
-
 
5586
 
-
 
5587
    //if lpD3DHWDeviceDesc.dcmColorModel = 0 then Exit;
-
 
5588
    if idoOptimizeDisplayMode in rec.Options then
-
 
5589
    begin
-
 
5590
      if (lpD3DDeviceDesc.dwDeviceRenderBitDepth and (DDBD_16 or DDBD_24 or DDBD_32)) = 0 then Exit;
-
 
5591
    end
-
 
5592
    else
-
 
5593
    begin
-
 
5594
      if (lpD3DDeviceDesc.dwDeviceRenderBitDepth and BPPToDDBD(rec.BitCount)) = 0 then Exit;
-
 
5595
    end;
-
 
5596
 
-
 
5597
    rec.D3DFlag := True;
-
 
5598
    rec.DeviceDesc2 := lpD3DDeviceDesc;
-
 
5599
  end;
-
 
5600
  {$ENDIF}
3068
 
5601
 
3069
  function EnumDirectDrawDriverCallback(lpGUID: PGUID; lpDriverDescription: LPSTR;
5602
  function EnumDirectDrawDriverCallback(lpGUID: PGUID; lpDriverDescription: {$IFDEF UNICODE}LPCTSTR{$ELSE}LPCSTR{$ENDIF};
3070
    lpDriverName: LPSTR; rec: PDirect3DInitializingRecord): HRESULT; stdcall;
5603
    lpDriverName: {$IFDEF UNICODE}LPCTSTR{$ELSE}LPCSTR{$ENDIF}; rec: PDirect3DInitializingRecord): HRESULT; stdcall;
3071
  var
5604
  var
3072
    DDraw: TDirectDraw;
5605
    DDraw: TDirectDraw;
-
 
5606
    {$IFDEF D3D_deprecated}
3073
    Direct3D: IDirect3D;
5607
    Direct3D: IDirect3D;
-
 
5608
    {$ENDIF}
3074
    Direct3D7: IDirect3D7;
5609
    Direct3D7: IDirect3D7;
3075
 
5610
 
3076
    function CountBitMask(i: DWORD; const Bits: array of DWORD): DWORD;
5611
    function CountBitMask(i: DWORD; const Bits: array of DWORD): DWORD;
3077
    var
5612
    var
3078
      j: Integer;
5613
      j: Integer;
3079
    begin
5614
    begin
3080
      Result := 0;
5615
      Result := 0;
3081
 
5616
 
3082
      for j:=Low(Bits) to High(Bits) do
5617
      for j := Low(Bits) to High(Bits) do
3083
      begin
5618
      begin
3084
        if i and Bits[j]<>0 then
5619
        if i and Bits[j] <> 0 then
3085
          Inc(Result);
5620
          Inc(Result);
3086
      end;
5621
      end;
3087
    end;
5622
    end;
3088
 
5623
 
3089
    function CompareCountBitMask(i, i2: DWORD; const Bits: array of DWORD): Integer;
5624
    function CompareCountBitMask(i, i2: DWORD; const Bits: array of DWORD): Integer;
Line 3091... Line 5626...
3091
      j, j2: DWORD;
5626
      j, j2: DWORD;
3092
    begin
5627
    begin
3093
      j := CountBitMask(i, Bits);
5628
      j := CountBitMask(i, Bits);
3094
      j2 := CountBitMask(i2, Bits);
5629
      j2 := CountBitMask(i2, Bits);
3095
 
5630
 
3096
      if j<j2 then
5631
      if j < j2 then
3097
        Result := -1
5632
        Result := -1
3098
      else if i>j2 then
5633
      else if i > j2 then
3099
        Result := 1
5634
        Result := 1
3100
      else
5635
      else
3101
        Result := 0;
5636
        Result := 0;
3102
    end;
5637
    end;
3103
 
5638
 
Line 3105... Line 5640...
3105
    var
5640
    var
3106
      j: Integer;
5641
      j: Integer;
3107
    begin
5642
    begin
3108
      Result := 0;
5643
      Result := 0;
3109
 
5644
 
3110
      for j:=0 to 31 do
5645
      for j := 0 to 31 do
3111
        if i and (1 shl j)<>0 then
5646
        if i and (1 shl j) <> 0 then
3112
          Inc(Result);
5647
          Inc(Result);
3113
    end;
5648
    end;
3114
 
5649
 
3115
    function CompareCountBit(i, i2: DWORD): Integer;
5650
    function CompareCountBit(i, i2: DWORD): Integer;
3116
    begin
5651
    begin
3117
      Result := CountBit(i)-CountBit(i2);
5652
      Result := CountBit(i) - CountBit(i2);
3118
      if Result<0 then Result := -1;
5653
      if Result < 0 then Result := -1;
3119
      if Result>0 then Result := 1;
5654
      if Result > 0 then Result := 1;
3120
    end;
5655
    end;
3121
 
5656
 
3122
    function FindDevice: Boolean;
5657
    function FindDevice: Boolean;
3123
    begin
5658
    begin
3124
      {  The Direct3D driver is examined.  }
5659
      {  The Direct3D driver is examined.  }
3125
      rec.D3DFlag := False;
5660
      rec.D3DFlag := False;
-
 
5661
      try
3126
      Direct3D.EnumDevices(@EnumDeviceCallBack, rec);
5662
        {$IFDEF D3D_deprecated}Direct3D{$ELSE}Direct3D7{$ENDIF}.EnumDevices(@EnumDeviceCallBack, rec) {= DD_OK}
-
 
5663
      except
-
 
5664
        on E: Exception do
-
 
5665
        begin
-
 
5666
          rec.D3DFlag := False;
-
 
5667
          // eventually catch  exception to automatic log
-
 
5668
          Log(E.Message {$IFNDEF VER4UP}, ChangefileExt(ParamStr(0), '.log'){$ENDIF});
-
 
5669
          //and cannot continue !!!
-
 
5670
          Result := False;
-
 
5671
          Exit;
-
 
5672
        end;
-
 
5673
      end;
3127
      Result := rec.D3DFlag;
5674
      Result := rec.D3DFlag;
3128
 
5675
 
3129
      if not Result then Exit;
5676
      if not Result then Exit;
3130
 
5677
 
3131
      {  Comparison of DirectDraw driver.  }
5678
      {  Comparison of DirectDraw driver.  }
3132
      if not rec.Flag then
5679
      if not rec.Flag then
3133
      begin
5680
      begin
-
 
5681
        {$IFDEF D3D_deprecated}
3134
        rec.HWDeviceDesc := rec.HWDeviceDesc2;
5682
        rec.HWDeviceDesc := rec.HWDeviceDesc2;
3135
        rec.HELDeviceDesc := rec.HELDeviceDesc2;
5683
        rec.HELDeviceDesc := rec.HELDeviceDesc2;
3136
        rec.DeviceDesc := rec.DeviceDesc2;
5684
        rec.DeviceDesc := rec.DeviceDesc2;
-
 
5685
        {$ENDIF}
3137
        rec.Flag := True;
5686
        rec.Flag := True;
-
 
5687
      end
3138
      end else
5688
      else
3139
      begin
5689
      begin
3140
        {  Comparison of hardware. (One with large number of functions to support is chosen.  }
5690
        {  Comparison of hardware. (One with large number of functions to support is chosen.  }
3141
        Result := False;
5691
        Result := False;
3142
 
5692
 
3143
        if DDraw.DriverCaps.dwVidMemTotal<rec.DriverCaps.dwVidMemTotal then Exit;
5693
        if DDraw.DriverCaps.dwVidMemTotal < rec.DriverCaps.dwVidMemTotal then Exit;
3144
 
-
 
-
 
5694
        {$IFDEF D3D_deprecated}
3145
        if CompareCountBitMask(DDraw.DriverCaps.ddscaps.dwCaps, rec.DriverCaps.ddscaps.dwCaps, [DDSCAPS_TEXTURE, DDSCAPS_ZBUFFER, DDSCAPS_MIPMAP])+
5695
        if CompareCountBitMask(DDraw.DriverCaps.ddscaps.dwCaps, rec.DriverCaps.ddscaps.dwCaps, [DDSCAPS_TEXTURE, DDSCAPS_ZBUFFER, DDSCAPS_MIPMAP]) +
3146
          CompareCountBit(rec.HWDeviceDesc.dpcLineCaps.dwMiscCaps, rec.HWDeviceDesc2.dpcLineCaps.dwMiscCaps)+
5696
          CompareCountBit(rec.HWDeviceDesc.dpcLineCaps.dwMiscCaps, rec.HWDeviceDesc2.dpcLineCaps.dwMiscCaps) +
3147
          CompareCountBit(rec.HWDeviceDesc.dpcLineCaps.dwRasterCaps, rec.HWDeviceDesc2.dpcLineCaps.dwRasterCaps)+
5697
          CompareCountBit(rec.HWDeviceDesc.dpcLineCaps.dwRasterCaps, rec.HWDeviceDesc2.dpcLineCaps.dwRasterCaps) +
3148
          CompareCountBit(rec.HWDeviceDesc.dpcLineCaps.dwAlphaCmpCaps, rec.HWDeviceDesc2.dpcLineCaps.dwAlphaCmpCaps)+
5698
          CompareCountBit(rec.HWDeviceDesc.dpcLineCaps.dwAlphaCmpCaps, rec.HWDeviceDesc2.dpcLineCaps.dwAlphaCmpCaps) +
3149
          CompareCountBit(rec.HWDeviceDesc.dpcLineCaps.dwSrcBlendCaps, rec.HWDeviceDesc2.dpcLineCaps.dwSrcBlendCaps)+
5699
          CompareCountBit(rec.HWDeviceDesc.dpcLineCaps.dwSrcBlendCaps, rec.HWDeviceDesc2.dpcLineCaps.dwSrcBlendCaps) +
3150
          CompareCountBit(rec.HWDeviceDesc.dpcLineCaps.dwDestBlendCaps, rec.HWDeviceDesc2.dpcLineCaps.dwDestBlendCaps)+
5700
          CompareCountBit(rec.HWDeviceDesc.dpcLineCaps.dwDestBlendCaps, rec.HWDeviceDesc2.dpcLineCaps.dwDestBlendCaps) +
3151
          CompareCountBit(rec.HWDeviceDesc.dpcLineCaps.dwShadeCaps, rec.HWDeviceDesc2.dpcLineCaps.dwShadeCaps)+
5701
          CompareCountBit(rec.HWDeviceDesc.dpcLineCaps.dwShadeCaps, rec.HWDeviceDesc2.dpcLineCaps.dwShadeCaps) +
3152
          CompareCountBit(rec.HWDeviceDesc.dpcLineCaps.dwTextureCaps, rec.HWDeviceDesc2.dpcLineCaps.dwTextureCaps)+
5702
          CompareCountBit(rec.HWDeviceDesc.dpcLineCaps.dwTextureCaps, rec.HWDeviceDesc2.dpcLineCaps.dwTextureCaps) +
3153
          CompareCountBit(rec.HWDeviceDesc.dpcLineCaps.dwTextureFilterCaps, rec.HWDeviceDesc2.dpcLineCaps.dwTextureFilterCaps)+
5703
          CompareCountBit(rec.HWDeviceDesc.dpcLineCaps.dwTextureFilterCaps, rec.HWDeviceDesc2.dpcLineCaps.dwTextureFilterCaps) +
3154
          CompareCountBit(rec.HWDeviceDesc.dpcLineCaps.dwTextureBlendCaps, rec.HWDeviceDesc2.dpcLineCaps.dwTextureBlendCaps)+
5704
          CompareCountBit(rec.HWDeviceDesc.dpcLineCaps.dwTextureBlendCaps, rec.HWDeviceDesc2.dpcLineCaps.dwTextureBlendCaps) +
3155
          CompareCountBit(rec.HWDeviceDesc.dpcLineCaps.dwTextureAddressCaps, rec.HWDeviceDesc2.dpcLineCaps.dwTextureAddressCaps)<0 then Exit;
5705
          CompareCountBit(rec.HWDeviceDesc.dpcLineCaps.dwTextureAddressCaps, rec.HWDeviceDesc2.dpcLineCaps.dwTextureAddressCaps) < 0 then Exit;
3156
 
5706
        {$ENDIF}
3157
        Result := True;
5707
        Result := True;
3158
      end;
5708
      end;
3159
    end;
5709
    end;
3160
 
5710
 
3161
  begin
5711
  begin
3162
    Result := DDENUMRET_OK;
5712
    Result := DDENUMRET_OK;
3163
 
5713
 
3164
    DDraw := TDirectDraw.Create(lpGUID);
5714
    DDraw := TDirectDraw.Create(lpGUID);
3165
    try
5715
    try
3166
      if (DDraw.DriverCaps.dwCaps and DDCAPS_3D<>0) and
5716
      if (DDraw.DriverCaps.dwCaps and DDCAPS_3D <> 0) and
3167
        (DDraw.DriverCaps.ddsCaps.dwCaps and DDSCAPS_TEXTURE<>0) then
5717
        (DDraw.DriverCaps.ddsCaps.dwCaps and DDSCAPS_TEXTURE <> 0) then
3168
      begin
5718
      begin
-
 
5719
        try
3169
        if DDraw.IDDraw7<>nil then
5720
        if DDraw.IDDraw7 <> nil then
3170
          Direct3D7 := DDraw.IDraw7 as IDirect3D7
5721
          Direct3D7 := DDraw.IDraw7 as IDirect3D7
-
 
5722
        {$IFDEF D3D_deprecated}
3171
        else
5723
        else
3172
          Direct3D := DDraw.IDraw as IDirect3D;
5724
          Direct3D := DDraw.{$IFDEF D3D_deprecated}IDraw{$ELSE}IDraw7{$ENDIF} as IDirect3D
-
 
5725
        {$ENDIF};
-
 
5726
        except
-
 
5727
          on E: Exception do
-
 
5728
            log(E.Message {$IFNDEF VER4UP}, ChangefileExt(ParamStr(0), '.log'){$ENDIF});
-
 
5729
        end;
3173
        try
5730
        try
3174
          if FindDevice then
5731
          if FindDevice then
3175
          begin
5732
          begin
3176
            rec.DriverCaps := DDraw.DriverCaps;
5733
            rec.DriverCaps := DDraw.DriverCaps;
3177
            rec.HELCaps := DDraw.HELCaps;
5734
            rec.HELCaps := DDraw.HELCaps;
3178
 
5735
 
3179
            if lpGUID=nil then
5736
            if lpGUID = nil then
3180
              rec.Driver := nil
5737
              rec.Driver := nil
-
 
5738
            else
3181
            else begin
5739
            begin
3182
              rec.DriverGUID^ := lpGUID^;
5740
              rec.DriverGUID^ := lpGUID^;
3183
              rec.Driver^ := @rec.DriverGUID;
5741
              rec.Driver^ := @rec.DriverGUID;
3184
            end;
5742
            end;
3185
          end;
5743
          end;
3186
        finally
5744
        finally
-
 
5745
          {$IFDEF D3D_deprecated}
3187
          Direct3D := nil;
5746
          Direct3D := nil;
-
 
5747
          {$ENDIF}
3188
          Direct3D7 := nil;
5748
          Direct3D7 := nil;
3189
        end;
5749
        end;
3190
      end;
5750
      end;
3191
    finally
5751
    finally
3192
      DDraw.Free;
5752
      DDraw.Free;
Line 3194... Line 5754...
3194
  end;
5754
  end;
3195
 
5755
 
3196
var
5756
var
3197
  rec: TDirect3DInitializingRecord;
5757
  rec: TDirect3DInitializingRecord;
3198
  DDraw: TDirectDraw;
5758
  DDraw: TDirectDraw;
-
 
5759
  {$IFNDEF D3D_deprecated}
-
 
5760
  devGUID: Tguid;
-
 
5761
  {$ENDIF}
3199
begin
5762
begin
3200
  FillChar(rec, SizeOf(rec), 0);
5763
  FillChar(rec, SizeOf(rec), 0);
3201
  rec.BitCount := BitCount;
5764
  rec.BitCount := BitCount;
3202
  rec.Options := Options;
5765
  rec.Options := Options;
3203
 
5766
 
Line 3206... Line 5769...
3206
  begin
5769
  begin
3207
    rec.Flag := False;
5770
    rec.Flag := False;
3208
    rec.Options := Options;
5771
    rec.Options := Options;
3209
    rec.Driver := @Driver;
5772
    rec.Driver := @Driver;
3210
    rec.DriverGUID := @DriverGUID;
5773
    rec.DriverGUID := @DriverGUID;
3211
    DXDirectDrawEnumerate(@EnumDirectDrawDriverCallback, @rec)
5774
    DXDirectDrawEnumerate(@EnumDirectDrawDriverCallback, @rec);
-
 
5775
  end
3212
  end else
5776
  else
3213
  begin
5777
  begin
3214
    DDraw := TDirectDraw.Create(Driver);
5778
    DDraw := TDirectDraw.Create(Driver);
3215
    try
5779
    try
3216
      rec.DriverCaps := DDraw.DriverCaps;
5780
      rec.DriverCaps := DDraw.DriverCaps;
3217
      rec.HELCaps := DDraw.HELCaps;
5781
      rec.HELCaps := DDraw.HELCaps;
3218
 
5782
 
3219
      rec.D3DFlag := False;
5783
      rec.D3DFlag := False;
3220
      (DDraw.IDraw as IDirect3D).EnumDevices(@EnumDeviceCallBack, @rec);
5784
      (DDraw.{$IFDEF D3D_deprecated}IDraw{$ELSE}IDraw7{$ENDIF} as IDirect3D).EnumDevices(@EnumDeviceCallBack, @rec);
3221
 
-
 
3222
      if rec.D3DFlag then
5785
      if rec.D3DFlag then
-
 
5786
        {$IFDEF D3D_deprecated}
-
 
5787
        rec.DeviceDesc := rec.DeviceDesc2;
-
 
5788
        {$ELSE}
3223
        rec.DeviceDesc := rec.DeviceDesc2;
5789
        rec.DeviceDesc := rec.DeviceDesc2;
-
 
5790
        {$ENDIF}
3224
    finally
5791
    finally
3225
      DDraw.Free;
5792
      DDraw.Free;
3226
    end;
5793
    end;
3227
    rec.Flag := True;
5794
    rec.Flag := True;
3228
  end;
5795
  end;
3229
 
5796
 
3230
  {  Display mode optimization  }
5797
  {  Display mode optimization  }
3231
  if rec.Flag and (idoOptimizeDisplayMode in Options) then
5798
  if rec.Flag and (idoOptimizeDisplayMode in Options) then
3232
  begin
5799
  begin
3233
    if (rec.DeviceDesc.dwDeviceRenderBitDepth and BPPToDDBD(rec.BitCount))=0 then
5800
    if (rec.DeviceDesc.dwDeviceRenderBitDepth and BPPToDDBD(rec.BitCount)) = 0 then
3234
    begin
5801
    begin
3235
      if rec.DeviceDesc.dwDeviceRenderBitDepth and DDBD_16<>0 then
5802
      if rec.DeviceDesc.dwDeviceRenderBitDepth and DDBD_16 <> 0 then
3236
        rec.BitCount := 16
5803
        rec.BitCount := 16
-
 
5804
      else
3237
      else if rec.DeviceDesc.dwDeviceRenderBitDepth and DDBD_24<>0 then
5805
      if rec.DeviceDesc.dwDeviceRenderBitDepth and DDBD_24 <> 0 then
3238
        rec.BitCount := 24
5806
        rec.BitCount := 24
3239
      else if rec.DeviceDesc.dwDeviceRenderBitDepth and DDBD_32<>0 then
5807
      else if rec.DeviceDesc.dwDeviceRenderBitDepth and DDBD_32 <> 0 then
3240
        rec.BitCount := 32;
5808
        rec.BitCount := 32;
3241
    end;
5809
    end;
3242
  end;
5810
  end;
3243
 
5811
 
-
 
5812
  {test type of device}
-
 
5813
  {$IFNDEF D3D_deprecated}
-
 
5814
  D3DDeviceTypeSet := [];
-
 
5815
 
-
 
5816
  Move(rec.DeviceDesc2.deviceGUID, devGUID, Sizeof(TGUID) );
-
 
5817
 
-
 
5818
  if CompareMem(@devGUID, @IID_IDirect3DTnLHalDevice, Sizeof(TGUID)) then
-
 
5819
    D3DDeviceTypeSet := D3DDeviceTypeSet + [dtTnLHAL];
-
 
5820
 
-
 
5821
  if CompareMem(@devGUID, @IID_IDirect3DHALDEVICE, Sizeof(TGUID)) then
-
 
5822
    D3DDeviceTypeSet := D3DDeviceTypeSet + [dtHAL];
-
 
5823
 
-
 
5824
  if CompareMem(@devGUID, @IID_IDirect3DMMXDevice, Sizeof(TGUID)) then
-
 
5825
    D3DDeviceTypeSet := D3DDeviceTypeSet + [dtMMX];
-
 
5826
 
-
 
5827
  if CompareMem(@devGUID, @IID_IDirect3DRGBDevice, Sizeof(TGUID)) then
-
 
5828
    D3DDeviceTypeSet := D3DDeviceTypeSet + [dtRGB];
-
 
5829
 
-
 
5830
  if CompareMem(@devGUID, @IID_IDirect3DRampDevice, Sizeof(TGUID)) then
-
 
5831
    D3DDeviceTypeSet := D3DDeviceTypeSet + [dtRamp];
-
 
5832
 
-
 
5833
  if CompareMem(@devGUID, @IID_IDirect3DRefDevice, Sizeof(TGUID)) then
-
 
5834
    D3DDeviceTypeSet := D3DDeviceTypeSet + [dtRef];
-
 
5835
  {$ENDIF}
3244
  BitCount := rec.BitCount;
5836
  BitCount := rec.BitCount;
3245
end;
5837
end;
3246
 
5838
 
3247
procedure Direct3DInitializing_DXDraw(Options: TInitializeDirect3DOptions;
5839
procedure Direct3DInitializing_DXDraw(Options: TInitializeDirect3DOptions;
3248
  DXDraw: TCustomDXDraw);
5840
  DXDraw: TCustomDXDraw);
3249
var
5841
var
3250
  BitCount: Integer;
5842
  BitCount: Integer;
3251
  Driver: PGUID;
5843
  Driver: PGUID;
3252
  DriverGUID: TGUID;
5844
  DriverGUID: TGUID;
-
 
5845
  {$IFNDEF D3D_deprecated}
-
 
5846
  D3DDeviceTypeSet: TD3DDeviceTypeSet;
-
 
5847
  {$ENDIF}
3253
begin
5848
begin
3254
  BitCount := DXDraw.Display.BitCount;
5849
  BitCount := DXDraw.Display.BitCount;
3255
  Driver := DXDraw.Driver;
5850
  Driver := DXDraw.Driver;
3256
  Direct3DInitializing(Options, BitCount, Driver, DriverGUID);
5851
  Direct3DInitializing(Options, BitCount, Driver, DriverGUID{$IFNDEF D3D_deprecated}, D3DDeviceTypeSet{$ENDIF});
3257
  DXDraw.Driver := Driver;
5852
  DXDraw.Driver := Driver;
3258
  DXDraw.Display.BitCount := BitCount;
5853
  DXDraw.Display.BitCount := BitCount;
-
 
5854
  {$IFNDEF D3D_deprecated}
-
 
5855
  DXDraw.FDeviceTypeSet := D3DDeviceTypeSet;
-
 
5856
  {$ENDIF}
3259
end;
5857
end;
3260
 
5858
 
-
 
5859
{$IFDEF D3D_deprecated}
3261
procedure InitializeDirect3D(Surface: TDirectDrawSurface;
5860
procedure InitializeDirect3D(Surface: TDirectDrawSurface;
3262
  var ZBuffer: TDirectDrawSurface;
5861
  var ZBuffer: TDirectDrawSurface;
3263
  out D3D: IDirect3D;
5862
  out D3D: IDirect3D;
3264
  out D3D2: IDirect3D2;
5863
  out D3D2: IDirect3D2;
3265
  out D3D3: IDirect3D3;
5864
  out D3D3: IDirect3D3;
3266
  out D3DDevice: IDirect3DDevice;
5865
  out D3DDevice: IDirect3DDevice;
3267
  out D3DDevice2: IDirect3DDevice2;
5866
  out D3DDevice2: IDirect3DDevice2;
3268
  out D3DDevice3: IDirect3DDevice3;
5867
  out D3DDevice3: IDirect3DDevice3;
-
 
5868
{$IFDEF D3DRM}
3269
  var D3DRM: IDirect3DRM;
5869
  var D3DRM: IDirect3DRM;
3270
  var D3DRM2: IDirect3DRM2;
5870
  var D3DRM2: IDirect3DRM2;
3271
  var D3DRM3: IDirect3DRM3;
5871
  var D3DRM3: IDirect3DRM3;
3272
  out D3DRMDevice: IDirect3DRMDevice;
5872
  out D3DRMDevice: IDirect3DRMDevice;
3273
  out D3DRMDevice2: IDirect3DRMDevice2;
5873
  out D3DRMDevice2: IDirect3DRMDevice2;
3274
  out D3DRMDevice3: IDirect3DRMDevice3;
5874
  out D3DRMDevice3: IDirect3DRMDevice3;
3275
  out Viewport: IDirect3DRMViewport;
5875
  out Viewport: IDirect3DRMViewport;
3276
  var Scene: IDirect3DRMFrame;
5876
  var Scene: IDirect3DRMFrame;
3277
  var Camera: IDirect3DRMFrame;
5877
  var Camera: IDirect3DRMFrame;
-
 
5878
{$ENDIF}
3278
  var NowOptions: TInitializeDirect3DOptions);
5879
  var NowOptions: TInitializeDirect3DOptions);
3279
type
5880
type
3280
  TInitializeDirect3DRecord = record
5881
  TInitializeDirect3DRecord = record
3281
    Flag: Boolean;
5882
    Flag: Boolean;
3282
    BitCount: Integer;
5883
    BitCount: Integer;
Line 3298... Line 5899...
3298
    ddsd: TDDSurfaceDesc;
5899
    ddsd: TDDSurfaceDesc;
3299
  begin
5900
  begin
3300
    Result := False;
5901
    Result := False;
3301
    FreeZBufferSurface(Surface, ZBuffer);
5902
    FreeZBufferSurface(Surface, ZBuffer);
3302
 
5903
 
3303
    if DeviceDesc.dwDeviceZBufferBitDepth and DDBD_16<>0 then
5904
    if DeviceDesc.dwDeviceZBufferBitDepth and DDBD_16 <> 0 then
3304
      ZBufferBitDepth := 16
5905
      ZBufferBitDepth := 16
-
 
5906
    else
3305
    else if DeviceDesc.dwDeviceZBufferBitDepth and DDBD_24<>0 then
5907
    if DeviceDesc.dwDeviceZBufferBitDepth and DDBD_24 <> 0 then
3306
      ZBufferBitDepth := 24
5908
      ZBufferBitDepth := 24
-
 
5909
    else
3307
    else if DeviceDesc.dwDeviceZBufferBitDepth and DDBD_32<>0 then
5910
    if DeviceDesc.dwDeviceZBufferBitDepth and DDBD_32 <> 0 then
3308
      ZBufferBitDepth := 32
5911
      ZBufferBitDepth := 32
3309
    else
5912
    else
3310
      ZBufferBitDepth := 0;
5913
      ZBufferBitDepth := 0;
3311
 
5914
 
3312
    if ZBufferBitDepth<>0 then
5915
    if ZBufferBitDepth <> 0 then
3313
    begin
5916
    begin
3314
      with ddsd do
5917
      with ddsd do
3315
      begin
5918
      begin
3316
        dwSize := SizeOf(ddsd);
5919
        dwSize := SizeOf(ddsd);
3317
        Surface.ISurface.GetSurfaceDesc(ddsd);
5920
        Surface.ISurface.GetSurfaceDesc(ddsd);
Line 3323... Line 5926...
3323
      end;
5926
      end;
3324
 
5927
 
3325
      ZBuffer := TDirectDrawSurface.Create(Surface.DDraw);
5928
      ZBuffer := TDirectDrawSurface.Create(Surface.DDraw);
3326
      if ZBuffer.CreateSurface(ddsd) then
5929
      if ZBuffer.CreateSurface(ddsd) then
3327
      begin
5930
      begin
3328
        if Surface.ISurface.AddAttachedSurface(ZBuffer.ISurface)<>DD_OK then
5931
        if Surface.ISurface.AddAttachedSurface(ZBuffer.ISurface) <> DD_OK then
3329
        begin
5932
        begin
3330
          ZBuffer.Free; ZBuffer := nil;
5933
          ZBuffer.Free; ZBuffer := nil;
3331
          Exit;
5934
          Exit;
3332
        end;
5935
        end;
3333
        Result := True;
5936
        Result := True;
Line 3337... Line 5940...
3337
        Exit;
5940
        Exit;
3338
      end;
5941
      end;
3339
    end;
5942
    end;
3340
  end;
5943
  end;
3341
 
5944
 
3342
 
-
 
3343
  function EnumDeviceCallBack(const lpGuid: TGUID; lpDeviceDescription, lpDeviceName: PChar;
5945
  function EnumDeviceCallBack(const lpGuid: TGUID; lpDeviceDescription, lpDeviceName: PChar;
3344
    const lpD3DHWDeviceDesc, lpD3DHELDeviceDesc: TD3DDeviceDesc;
5946
    const lpD3DHWDeviceDesc, lpD3DHELDeviceDesc: TD3DDeviceDesc;
3345
    lpUserArg: Pointer): HRESULT; stdcall;
5947
    lpUserArg: Pointer): HRESULT; stdcall;
3346
  var
5948
  var
3347
    dev: ^TD3DDeviceDesc;
5949
    dev: ^TD3DDeviceDesc;
Line 3360... Line 5962...
3360
 
5962
 
3361
  begin
5963
  begin
3362
    Result := D3DENUMRET_OK;
5964
    Result := D3DENUMRET_OK;
3363
    rec := lpUserArg;
5965
    rec := lpUserArg;
3364
 
5966
 
3365
    Hardware := lpD3DHWDeviceDesc.dcmColorModel<>0;
5967
    Hardware := lpD3DHWDeviceDesc.dcmColorModel <> 0;
3366
    if Hardware then
5968
    if Hardware then
3367
      dev := @lpD3DHWDeviceDesc
5969
      dev := @lpD3DHWDeviceDesc
3368
    else
5970
    else
3369
      dev := @lpD3DHELDeviceDesc;
5971
      dev := @lpD3DHELDeviceDesc;
3370
 
5972
 
3371
    if (Hardware) and (not rec.SupportHardware) then Exit;
5973
    if (Hardware) and (not rec.SupportHardware) then Exit;
3372
    if dev.dcmColorModel<>D3DCOLOR_RGB then Exit;
5974
    if dev.dcmColorModel <> D3DCOLOR_RGB then Exit;
3373
    if CompareMem(@lpGUID, @IID_IDirect3DRefDevice, SizeOf(TGUID)) then Exit;
5975
    if CompareMem(@lpGUID, @IID_IDirect3DRefDevice, SizeOf(TGUID)) then Exit;
3374
 
5976
 
3375
    {  Bit depth test.  }
5977
    {  Bit depth test.  }
3376
    if (dev.dwDeviceRenderBitDepth and BPPToDDBD(rec.BitCount))=0 then Exit;
5978
    if (dev.dwDeviceRenderBitDepth and BPPToDDBD(rec.BitCount)) = 0 then Exit;
3377
 
5979
 
3378
    if Hardware then
5980
    if Hardware then
3379
    begin
5981
    begin
3380
      {  Hardware  }
5982
      {  Hardware  }
3381
      UseThisDevice;
5983
      UseThisDevice;
Line 3420... Line 6022...
3420
    begin
6022
    begin
3421
      if CreateZBufferSurface(Surface, ZBuffer, rec.DeviceDesc, Hardware) then
6023
      if CreateZBufferSurface(Surface, ZBuffer, rec.DeviceDesc, Hardware) then
3422
        NowOptions := NowOptions + [idoZBuffer];
6024
        NowOptions := NowOptions + [idoZBuffer];
3423
    end;
6025
    end;
3424
  end;
6026
  end;
3425
 
6027
{$IFDEF D3DRM}
3426
type
6028
type
3427
  TDirect3DRMCreate= function(out lplpDirect3DRM: IDirect3DRM): HRESULT; stdcall;
6029
  TDirect3DRMCreate = function(out lplpDirect3DRM: IDirect3DRM): HRESULT; stdcall;
-
 
6030
{$ENDIF}
3428
begin
6031
begin
3429
  try
6032
  try
3430
    Options := NowOptions;
6033
    Options := NowOptions;
3431
    NowOptions := [];
6034
    NowOptions := [];
3432
 
6035
 
3433
    D3D3 := Surface.DDraw.IDraw as IDirect3D3;
6036
    D3D3 := Surface.DDraw.IDraw as IDirect3D3;
3434
    D3D2 := D3D3 as IDirect3D2;
6037
    D3D2 := D3D3 as IDirect3D2;
3435
    D3D := D3D3 as IDirect3D;
6038
    D3D := D3D3 as IDirect3D;
3436
 
6039
 
3437
    {  Whether hardware can be used is tested.  }
6040
    {  Whether hardware can be used is tested.  }
3438
    SupportHardware := (Surface.SurfaceDesc.ddsCaps.dwCaps and DDSCAPS_VIDEOMEMORY<>0) and
6041
    SupportHardware := (Surface.SurfaceDesc.ddsCaps.dwCaps and DDSCAPS_VIDEOMEMORY <> 0) and
3439
      (idoHardware in Options) and (Surface.DDraw.DriverCaps.dwCaps and DDCAPS_3D<>0);
6042
      (idoHardware in Options) and (Surface.DDraw.DriverCaps.dwCaps and DDCAPS_3D <> 0);
3440
 
6043
 
3441
    if Surface.DDraw.DriverCaps.ddsCaps.dwCaps and DDSCAPS_TEXTURE=0 then
6044
    if Surface.DDraw.DriverCaps.ddsCaps.dwCaps and DDSCAPS_TEXTURE = 0 then
3442
      SupportHardware := False;
6045
      SupportHardware := False;
3443
 
6046
 
3444
    {  Direct3D  }
6047
    {  Direct3D  }
3445
    InitDevice;
6048
    InitDevice;
3446
 
6049
 
3447
    if D3D3.CreateDevice(D3DDeviceGUID, Surface.ISurface4, D3DDevice3, nil)<>D3D_OK then
6050
    if D3D3.CreateDevice(D3DDeviceGUID, Surface.ISurface4, D3DDevice3, nil) <> D3D_OK then
3448
    begin
6051
    begin
3449
      SupportHardware := False;
6052
      SupportHardware := False;
3450
      InitDevice;
6053
      InitDevice;
3451
      if D3D3.CreateDevice(D3DDeviceGUID, Surface.ISurface4, D3DDevice3, nil)<>D3D_OK then
6054
      if D3D3.CreateDevice(D3DDeviceGUID, Surface.ISurface4, D3DDevice3, nil) <> D3D_OK then
3452
        raise EDXDrawError.CreateFmt(SCannotMade, ['IDirect3DDevice3']);
6055
        raise EDXDrawError.CreateFmt(SCannotMade, ['IDirect3DDevice3']);
3453
    end;
6056
    end;
3454
 
6057
 
3455
    if SupportHardware then NowOptions := NowOptions + [idoHardware];
6058
    if SupportHardware then NowOptions := NowOptions + [idoHardware];
3456
 
6059
 
Line 3458... Line 6061...
3458
    D3DDevice := D3DDevice3 as IDirect3DDevice;
6061
    D3DDevice := D3DDevice3 as IDirect3DDevice;
3459
 
6062
 
3460
    with D3DDevice3 do
6063
    with D3DDevice3 do
3461
    begin
6064
    begin
3462
      SetRenderState(TD3DRenderStateType(D3DRENDERSTATE_DITHERENABLE), 1);
6065
      SetRenderState(TD3DRenderStateType(D3DRENDERSTATE_DITHERENABLE), 1);
3463
      SetRenderState(TD3DRenderStateType(D3DRENDERSTATE_ZENABLE), Ord(ZBuffer<>nil));
6066
      SetRenderState(TD3DRenderStateType(D3DRENDERSTATE_ZENABLE), Ord(ZBuffer <> nil));
3464
      SetRenderState(TD3DRenderStateType(D3DRENDERSTATE_ZWRITEENABLE), Ord(ZBuffer<>nil));
6067
      SetRenderState(TD3DRenderStateType(D3DRENDERSTATE_ZWRITEENABLE), Ord(ZBuffer <> nil));
3465
    end;
6068
    end;
3466
 
6069
{$IFDEF D3DRM}
3467
    {  Direct3D Retained Mode}
6070
    {  Direct3D Retained Mode}
3468
    if idoRetainedMode in Options then
6071
    if idoRetainedMode in Options then
3469
    begin
6072
    begin
3470
      NowOptions := NowOptions + [idoRetainedMode];
6073
      NowOptions := NowOptions + [idoRetainedMode];
3471
 
-
 
3472
      if D3DRM=nil then
6074
      if D3DRM = nil then
3473
      begin
6075
      begin
3474
        if TDirect3DRMCreate(DXLoadLibrary('D3DRM.dll', 'Direct3DRMCreate'))(D3DRM)<>D3DRM_OK then
6076
        if TDirect3DRMCreate(DXLoadLibrary('D3DRM.dll', 'Direct3DRMCreate'))(D3DRM) <> D3DRM_OK then
3475
          raise EDXDrawError.CreateFmt(SCannotInitialized, [SDirect3DRM]);
6077
          raise EDXDrawError.CreateFmt(SCannotInitialized, [SDirect3DRM]);
3476
        D3DRM2 := D3DRM as IDirect3DRM2;
6078
        D3DRM2 := D3DRM as IDirect3DRM2;
3477
        D3DRM3 := D3DRM as IDirect3DRM3;
6079
        D3DRM3 := D3DRM as IDirect3DRM3;
3478
      end;
6080
      end;
3479
 
6081
 
3480
      if D3DRM3.CreateDeviceFromD3D(D3D2, D3DDevice2, D3DRMDevice3)<>D3DRM_OK then
6082
      if D3DRM3.CreateDeviceFromD3D(D3D2, D3DDevice2, D3DRMDevice3) <> D3DRM_OK then
3481
        raise EDXDrawError.CreateFmt(SCannotMade, ['IDirect3DRMDevice2']);
6083
        raise EDXDrawError.CreateFmt(SCannotMade, ['IDirect3DRMDevice2']);
3482
 
6084
 
3483
      D3DRMDevice3.SetBufferCount(2);
6085
      D3DRMDevice3.SetBufferCount(2);
3484
      D3DRMDevice := D3DRMDevice3 as IDirect3DRMDevice;
6086
      D3DRMDevice := D3DRMDevice3 as IDirect3DRMDevice;
3485
      D3DRMDevice2 := D3DRMDevice3 as IDirect3DRMDevice2;
6087
      D3DRMDevice2 := D3DRMDevice3 as IDirect3DRMDevice2;
Line 3487... Line 6089...
3487
      {  Rendering state setting  }
6089
      {  Rendering state setting  }
3488
      D3DRMDevice.SetQuality(D3DRMLIGHT_ON or D3DRMFILL_SOLID or D3DRMSHADE_GOURAUD);
6090
      D3DRMDevice.SetQuality(D3DRMLIGHT_ON or D3DRMFILL_SOLID or D3DRMSHADE_GOURAUD);
3489
      D3DRMDevice.SetTextureQuality(D3DRMTEXTURE_NEAREST);
6091
      D3DRMDevice.SetTextureQuality(D3DRMTEXTURE_NEAREST);
3490
      D3DRMDevice.SetDither(True);
6092
      D3DRMDevice.SetDither(True);
3491
 
6093
 
3492
      if Surface.BitCount=8 then
6094
      if Surface.BitCount = 8 then
3493
      begin
6095
      begin
3494
        D3DRMDevice.SetShades(8);
6096
        D3DRMDevice.SetShades(8);
3495
        D3DRM.SetDefaultTextureColors(64);
6097
        D3DRM.SetDefaultTextureColors(64);
3496
        D3DRM.SetDefaultTextureShades(32);
6098
        D3DRM.SetDefaultTextureShades(32);
3497
      end else
6099
      end else
Line 3499... Line 6101...
3499
        D3DRM.SetDefaultTextureColors(64);
6101
        D3DRM.SetDefaultTextureColors(64);
3500
        D3DRM.SetDefaultTextureShades(32);
6102
        D3DRM.SetDefaultTextureShades(32);
3501
      end;
6103
      end;
3502
 
6104
 
3503
      {  Frame making  }
6105
      {  Frame making  }
3504
      if Scene=nil then
6106
      if Scene = nil then
3505
      begin
6107
      begin
3506
        D3DRM.CreateFrame(nil, Scene);
6108
        D3DRM.CreateFrame(nil, Scene);
3507
        D3DRM.CreateFrame(Scene, Camera);
6109
        D3DRM.CreateFrame(Scene, Camera);
3508
        Camera.SetPosition(Camera, 0, 0, 0);
6110
        Camera.SetPosition(Camera, 0, 0, 0);
3509
      end;
6111
      end;
Line 3511... Line 6113...
3511
      {  Viewport making  }
6113
      {  Viewport making  }
3512
      D3DRM.CreateViewport(D3DRMDevice, Camera, 0, 0,
6114
      D3DRM.CreateViewport(D3DRMDevice, Camera, 0, 0,
3513
        Surface.Width, Surface.Height, Viewport);
6115
        Surface.Width, Surface.Height, Viewport);
3514
      Viewport.SetBack(5000.0);
6116
      Viewport.SetBack(5000.0);
3515
    end;
6117
    end;
-
 
6118
{$ENDIF}
3516
  except
6119
   except
3517
    FreeZBufferSurface(Surface, ZBuffer);
6120
    FreeZBufferSurface(Surface, ZBuffer);
3518
    D3D := nil;
6121
    D3D := nil;
3519
    D3D2 := nil;
6122
    D3D2 := nil;
3520
    D3D3 := nil;
6123
    D3D3 := nil;
3521
    D3DDevice := nil;
6124
    D3DDevice := nil;
3522
    D3DDevice2 := nil;
6125
    D3DDevice2 := nil;
3523
    D3DDevice3 := nil;
6126
    D3DDevice3 := nil;
-
 
6127
{$IFDEF D3DRM}
3524
    D3DRM := nil;
6128
    D3DRM := nil;
3525
    D3DRM2 := nil;
6129
    D3DRM2 := nil;
3526
    D3DRMDevice := nil;
6130
    D3DRMDevice := nil;
3527
    D3DRMDevice2 := nil;
6131
    D3DRMDevice2 := nil;
3528
    Viewport := nil;
6132
    Viewport := nil;
3529
    Scene := nil;
6133
    Scene := nil;
3530
    Camera := nil;
6134
    Camera := nil;
-
 
6135
{$ENDIF}
3531
    raise;
6136
    raise;
3532
  end;
6137
  end;
3533
end;
6138
end;
-
 
6139
{$ENDIF}
3534
 
6140
 
3535
procedure InitializeDirect3D7(Surface: TDirectDrawSurface;
6141
procedure InitializeDirect3D7(Surface: TDirectDrawSurface;
3536
  var ZBuffer: TDirectDrawSurface;
6142
  var ZBuffer: TDirectDrawSurface;
3537
  out D3D7: IDirect3D7;
6143
  out D3D7: IDirect3D7;
3538
  out D3DDevice7: IDirect3DDevice7;
6144
  out D3DDevice7: IDirect3DDevice7;
Line 3551... Line 6157...
3551
    const DeviceDesc: TD3DDeviceDesc7; Hardware: Boolean): Boolean;
6157
    const DeviceDesc: TD3DDeviceDesc7; Hardware: Boolean): Boolean;
3552
  const
6158
  const
3553
    MemPosition: array[Boolean] of Integer = (DDSCAPS_SYSTEMMEMORY, DDSCAPS_VIDEOMEMORY);
6159
    MemPosition: array[Boolean] of Integer = (DDSCAPS_SYSTEMMEMORY, DDSCAPS_VIDEOMEMORY);
3554
  var
6160
  var
3555
    ZBufferBitDepth: Integer;
6161
    ZBufferBitDepth: Integer;
3556
    ddsd: TDDSurfaceDesc;
6162
    ddsd: {$IFDEF D3D_deprecated}TDDSurfaceDesc{$ELSE}TDDSurfaceDesc2{$ENDIF};
3557
  begin
6163
  begin
3558
    Result := False;
6164
    Result := False;
3559
    FreeZBufferSurface(Surface, ZBuffer);
6165
    FreeZBufferSurface(Surface, ZBuffer);
3560
 
6166
 
3561
    if DeviceDesc.dwDeviceZBufferBitDepth and DDBD_16<>0 then
6167
    if DeviceDesc.dwDeviceZBufferBitDepth and DDBD_16 <> 0 then
3562
      ZBufferBitDepth := 16
6168
      ZBufferBitDepth := 16
3563
    else if DeviceDesc.dwDeviceZBufferBitDepth and DDBD_24<>0 then
6169
    else if DeviceDesc.dwDeviceZBufferBitDepth and DDBD_24 <> 0 then
3564
      ZBufferBitDepth := 24
6170
      ZBufferBitDepth := 24
3565
    else if DeviceDesc.dwDeviceZBufferBitDepth and DDBD_32<>0 then
6171
    else if DeviceDesc.dwDeviceZBufferBitDepth and DDBD_32 <> 0 then
3566
      ZBufferBitDepth := 32
6172
      ZBufferBitDepth := 32
3567
    else
6173
    else
3568
      ZBufferBitDepth := 0;
6174
      ZBufferBitDepth := 0;
3569
 
6175
 
3570
    if ZBufferBitDepth<>0 then
6176
    if ZBufferBitDepth <> 0 then
3571
    begin
6177
    begin
3572
      with ddsd do
6178
      with ddsd do
3573
      begin
6179
      begin
3574
        dwSize := SizeOf(ddsd);
6180
        dwSize := SizeOf(ddsd);
3575
        Surface.ISurface.GetSurfaceDesc(ddsd);
6181
        Surface.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}.GetSurfaceDesc(ddsd);
3576
        dwFlags := DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT or DDSD_ZBUFFERBITDEPTH;
6182
        dwFlags := DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT or DDSD_ZBUFFERBITDEPTH;
3577
        ddsCaps.dwCaps := DDSCAPS_ZBUFFER or MemPosition[Hardware];
6183
        ddsCaps.dwCaps := DDSCAPS_ZBUFFER or MemPosition[Hardware];
3578
        dwHeight := Surface.Height;
6184
        dwHeight := Surface.Height;
3579
        dwWidth := Surface.Width;
6185
        dwWidth := Surface.Width;
-
 
6186
        {$IFDEF D3D_deprecated}
3580
        dwZBufferBitDepth := ZBufferBitDepth;
6187
        dwZBufferBitDepth := ZBufferBitDepth;
-
 
6188
        {$ELSE}
-
 
6189
        ddpfPixelFormat.dwFlags := DDPF_ZBUFFER;
-
 
6190
        ddpfPixelFormat.dwZBufferBitDepth := ZBufferBitDepth;
-
 
6191
        ddpfPixelFormat.dwStencilBitDepth := 0;
-
 
6192
        ddpfPixelFormat.dwZBitMask := (1 shl ZBufferBitDepth) - 1;
-
 
6193
        ddpfPixelFormat.dwStencilBitMask := 0;
-
 
6194
        ddpfPixelFormat.dwLuminanceAlphaBitMask := 0;
-
 
6195
        {$ENDIF}
3581
      end;
6196
      end;
3582
 
6197
 
3583
      ZBuffer := TDirectDrawSurface.Create(Surface.DDraw);
6198
      ZBuffer := TDirectDrawSurface.Create(Surface.DDraw);
3584
      if ZBuffer.CreateSurface(ddsd) then
6199
      if ZBuffer.CreateSurface(ddsd) then
3585
      begin
6200
      begin
3586
        if Surface.ISurface.AddAttachedSurface(ZBuffer.ISurface)<>DD_OK then
6201
        if Surface.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}.AddAttachedSurface(ZBuffer.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}) <> DD_OK then
3587
        begin
6202
        begin
3588
          ZBuffer.Free; ZBuffer := nil;
6203
          ZBuffer.Free; ZBuffer := nil;
3589
          Exit;
6204
          Exit;
3590
        end;
6205
        end;
3591
        Result := True;
6206
        Result := True;
Line 3612... Line 6227...
3612
 
6227
 
3613
  begin
6228
  begin
3614
    Result := D3DENUMRET_OK;
6229
    Result := D3DENUMRET_OK;
3615
    rec := lpUserArg;
6230
    rec := lpUserArg;
3616
 
6231
 
3617
    Hardware := lpTD3DDeviceDesc.dwDevCaps and D3DDEVCAPS_HWRASTERIZATION<>0;
6232
    Hardware := lpTD3DDeviceDesc.dwDevCaps and D3DDEVCAPS_HWRASTERIZATION <> 0;
3618
 
6233
 
3619
    if Hardware and (not rec.SupportHardware) then Exit;
6234
    if Hardware and (not rec.SupportHardware) then Exit;
3620
    if CompareMem(@lpTD3DDeviceDesc.deviceGUID, @IID_IDirect3DRefDevice, SizeOf(TGUID)) then Exit;
6235
    if CompareMem(@lpTD3DDeviceDesc.deviceGUID, @IID_IDirect3DRefDevice, SizeOf(TGUID)) then Exit;
3621
 
6236
 
3622
    {  Bit depth test.  }
6237
    {  Bit depth test.  }
3623
    if (lpTD3DDeviceDesc.dwDeviceRenderBitDepth and BPPToDDBD(rec.BitCount))=0 then Exit;
6238
    if (lpTD3DDeviceDesc.dwDeviceRenderBitDepth and BPPToDDBD(rec.BitCount)) = 0 then Exit;
3624
 
6239
 
3625
    if Hardware then
6240
    if Hardware then
3626
    begin
6241
    begin
3627
      {  Hardware  }
6242
      {  Hardware  }
3628
      UseThisDevice;
6243
      UseThisDevice;
Line 3669... Line 6284...
3669
        NowOptions := NowOptions + [idoZBuffer];
6284
        NowOptions := NowOptions + [idoZBuffer];
3670
    end;
6285
    end;
3671
  end;
6286
  end;
3672
 
6287
 
3673
begin
6288
begin
-
 
6289
 
3674
  try
6290
  try
3675
    Options := NowOptions - [idoRetainedMode];
6291
    Options := NowOptions {$IFDEF D3DRM}- [idoRetainedMode]{$ENDIF};
3676
    NowOptions := [];
6292
    NowOptions := [];
3677
 
6293
 
3678
    D3D7 := Surface.DDraw.IDraw7 as IDirect3D7;
6294
    D3D7 := Surface.DDraw.IDraw7 as IDirect3D7;
3679
 
6295
 
3680
    {  Whether hardware can be used is tested.  }
6296
    {  Whether hardware can be used is tested.  }
3681
    SupportHardware := (Surface.SurfaceDesc.ddsCaps.dwCaps and DDSCAPS_VIDEOMEMORY<>0) and
6297
    SupportHardware := (Surface.SurfaceDesc.ddsCaps.dwCaps and DDSCAPS_VIDEOMEMORY <> 0) and
3682
      (idoHardware in Options) and (Surface.DDraw.DriverCaps.dwCaps and DDCAPS_3D<>0);
6298
      (idoHardware in Options) and (Surface.DDraw.DriverCaps.dwCaps and DDCAPS_3D <> 0) and
3683
 
-
 
3684
    if Surface.DDraw.DriverCaps.ddsCaps.dwCaps and DDSCAPS_TEXTURE=0 then
6299
      (Surface.DDraw.DriverCaps.ddsCaps.dwCaps and DDSCAPS_TEXTURE <> 0);
3685
      SupportHardware := False;
-
 
3686
 
6300
 
3687
    {  Direct3D  }
6301
    {  Direct3D  }
3688
    InitDevice;
6302
    InitDevice;
3689
 
6303
 
3690
    if D3D7.CreateDevice(D3DDeviceGUID, Surface.ISurface7, D3DDevice7)<>D3D_OK then
6304
    if D3D7.CreateDevice(D3DDeviceGUID, Surface.ISurface7, D3DDevice7) <> D3D_OK then
3691
    begin
6305
    begin
3692
      SupportHardware := False;
6306
      SupportHardware := False;
3693
      InitDevice;
6307
      InitDevice;
3694
      if D3D7.CreateDevice(D3DDeviceGUID, Surface.ISurface7, D3DDevice7)<>D3D_OK then
6308
      if D3D7.CreateDevice(D3DDeviceGUID, Surface.ISurface7, D3DDevice7) <> D3D_OK then
3695
        raise EDXDrawError.CreateFmt(SCannotMade, ['IDirect3DDevice7']);
6309
        raise EDXDrawError.CreateFmt(SCannotMade, ['IDirect3DDevice7']);
3696
    end;
6310
    end;
3697
 
6311
 
3698
    if SupportHardware then NowOptions := NowOptions + [idoHardware];
6312
    if SupportHardware then NowOptions := NowOptions + [idoHardware];
3699
  except
6313
  except
Line 3701... Line 6315...
3701
    D3D7 := nil;
6315
    D3D7 := nil;
3702
    D3DDevice7 := nil;
6316
    D3DDevice7 := nil;
3703
    raise;
6317
    raise;
3704
  end;
6318
  end;
3705
end;
6319
end;
3706
 
-
 
3707
type
6320
type
-
 
6321
 
3708
  {  TDXDrawDriver  }
6322
{  TDXDrawDriver  }
3709
 
6323
 
3710
  TDXDrawDriver = class
6324
  TDXDrawDriver = class
3711
  private
6325
  private
3712
    FDXDraw: TCustomDXDraw;
6326
    FDXDraw: TCustomDXDraw;
3713
    constructor Create(ADXDraw: TCustomDXDraw); virtual;
6327
    constructor Create(ADXDraw: TCustomDXDraw); virtual;
Line 3732... Line 6346...
3732
  private
6346
  private
3733
    procedure Flip; override;
6347
    procedure Flip; override;
3734
    procedure Initialize; override;
6348
    procedure Initialize; override;
3735
  end;
6349
  end;
3736
 
6350
 
-
 
6351
procedure TCustomDXDraw.MirrorFlip(Value: TRenderMirrorFlipSet);
-
 
6352
begin
-
 
6353
  if CheckD3 then
-
 
6354
    FD2D.MirrorFlip := Value;
-
 
6355
end;
-
 
6356
 
-
 
6357
procedure TCustomDXDraw.SaveTextures(path: string);
-
 
6358
begin
-
 
6359
  if CheckD3 then
-
 
6360
    FD2D.SaveTextures(path)
-
 
6361
end;
3737
{  TDXDrawDriver  }
6362
{  TDXDrawDriver  }
3738
 
6363
 
3739
constructor TDXDrawDriver.Create(ADXDraw: TCustomDXDraw);
6364
constructor TDXDrawDriver.Create(ADXDraw: TCustomDXDraw);
3740
var
6365
var
3741
  AOptions: TInitializeDirect3DOptions;
6366
  AOptions: TInitializeDirect3DOptions;
3742
begin
6367
begin
3743
  inherited Create;
6368
  inherited Create;
3744
  FDXDraw := ADXDraw;
6369
  FDXDraw := ADXDraw;
3745
 
6370
 
3746
  {  Driver selection and Display mode optimizationn }
6371
  {  Driver selection and Display mode optimizationn }
3747
  if FDXDraw.FOptions*[doFullScreen, doSystemMemory, do3D, doHardware]=
6372
  if FDXDraw.FOptions * [doFullScreen, doSystemMemory, {$IFDEF D3D_deprecated}do3D,{$ENDIF} doHardware] =
3748
    [doFullScreen, do3D, doHardware] then
6373
    [doFullScreen, {$IFDEF D3D_deprecated}do3D,{$ENDIF} doHardware] then
3749
  begin
6374
  begin
3750
    AOptions := [];
6375
    AOptions := [];
3751
    with FDXDraw do
6376
    with FDXDraw do
3752
    begin
6377
    begin
3753
      if doSelectDriver in Options then AOptions := AOptions + [idoSelectDriver];
6378
      if doSelectDriver in Options then AOptions := AOptions + [idoSelectDriver];
3754
      if not FDXDraw.Display.FixedBitCount then AOptions := AOptions + [idoOptimizeDisplayMode];
6379
      if not FDXDraw.Display.FixedBitCount then AOptions := AOptions + [idoOptimizeDisplayMode];
3755
 
6380
 
3756
      if doHardware in Options then AOptions := AOptions + [idoHardware];
6381
      if doHardware in Options then AOptions := AOptions + [idoHardware];
3757
      if doRetainedMode in Options then AOptions := AOptions + [idoRetainedMode];
6382
      {$IFDEF D3DRM}if doRetainedMode in Options then AOptions := AOptions + [idoRetainedMode];{$ENDIF}
3758
      if doZBuffer in Options then AOptions := AOptions + [idoZBuffer];
6383
      if doZBuffer in Options then AOptions := AOptions + [idoZBuffer];
3759
    end;
6384
    end;
3760
 
6385
 
3761
    Direct3DInitializing_DXDraw(AOptions, FDXDraw);
6386
    Direct3DInitializing_DXDraw(AOptions, FDXDraw);
3762
  end;
6387
  end;
3763
 
6388
 
3764
  if FDXDraw.Options*[doFullScreen, doHardware, doSystemMemory]=[doFullScreen, doHardware] then
6389
  if FDXDraw.Options * [doFullScreen, doHardware, doSystemMemory] = [doFullScreen, doHardware] then
3765
    FDXDraw.FDDraw := TDirectDraw.CreateEx(PGUID(FDXDraw.FDriver), doDirectX7Mode in FDXDraw.Options)
6390
    FDXDraw.FDDraw := TDirectDraw.CreateEx(PGUID(FDXDraw.FDriver), {$IFDEF D3D_deprecated}doDirectX7Mode in FDXDraw.Options{$ELSE}True{$ENDIF})
3766
  else
6391
  else
3767
    FDXDraw.FDDraw := TDirectDraw.CreateEx(nil, doDirectX7Mode in FDXDraw.Options);
6392
    FDXDraw.FDDraw := TDirectDraw.CreateEx(nil, {$IFDEF D3D_deprecated}doDirectX7Mode in FDXDraw.Options{$ELSE}True{$ENDIF});
3768
end;
6393
end;
3769
 
6394
 
3770
procedure TDXDrawDriver.Initialize3D;
6395
procedure TDXDrawDriver.Initialize3D;
3771
const
6396
const
3772
  DXDrawOptions3D = [doHardware, doRetainedMode, doSelectDriver, doZBuffer];
6397
  DXDrawOptions3D = [doHardware, {$IFDEF D3DRM}doRetainedMode,{$ENDIF} doSelectDriver, doZBuffer];
3773
var
6398
var
3774
  AOptions: TInitializeDirect3DOptions;
6399
  AOptions: TInitializeDirect3DOptions;
3775
begin
6400
begin
3776
  AOptions := [];
6401
  AOptions := [];
3777
  with FDXDraw do
6402
  with FDXDraw do
3778
  begin
6403
  begin
3779
    if doHardware in FOptions then AOptions := AOptions + [idoHardware];
6404
    if doHardware in FOptions then AOptions := AOptions + [idoHardware];
3780
    if doRetainedMode in FNowOptions then AOptions := AOptions + [idoRetainedMode];
6405
    {$IFDEF D3DRM}if doRetainedMode in FNowOptions then AOptions := AOptions + [idoRetainedMode];{$ENDIF}
3781
    if doSelectDriver in FOptions then AOptions := AOptions + [idoSelectDriver];
6406
    if doSelectDriver in FOptions then AOptions := AOptions + [idoSelectDriver];
3782
    if doZBuffer in FOptions then AOptions := AOptions + [idoZBuffer];
6407
    if doZBuffer in FOptions then AOptions := AOptions + [idoZBuffer];
3783
 
-
 
-
 
6408
    {$IFDEF D3D_deprecated}
3784
    if doDirectX7Mode in FOptions then
6409
    if doDirectX7Mode in FOptions then
3785
    begin
6410
    begin
3786
      InitializeDirect3D7(FSurface, FZBuffer, FD3D7, FD3DDevice7, AOptions);
6411
      InitializeDirect3D7(FSurface, FZBuffer, FD3D7, FD3DDevice7, AOptions);
3787
    end else
6412
    end else
3788
    begin
6413
    begin
3789
      InitializeDirect3D(FSurface, FZBuffer, FD3D, FD3D2, FD3D3, FD3DDevice, FD3DDevice2, FD3DDevice3,
6414
      InitializeDirect3D(FSurface, FZBuffer, FD3D, FD3D2, FD3D3, FD3DDevice, FD3DDevice2, FD3DDevice3,
-
 
6415
        {$IFDEF D3DRM}
3790
        FD3DRM, FD3DRM2, FD3DRM3, FD3DRMDevice, FD3DRMDevice2, FD3DRMDevice3, FViewport, FScene, FCamera, AOptions);
6416
        FD3DRM, FD3DRM2, FD3DRM3, FD3DRMDevice, FD3DRMDevice2, FD3DRMDevice3, FViewport, FScene, FCamera,
-
 
6417
        {$ENDIF}
-
 
6418
        AOptions);
3791
    end;
6419
    end;
3792
 
6420
    {$ELSE}
-
 
6421
    InitializeDirect3D7(FSurface, FZBuffer, FD3D7, FD3DDevice7, AOptions);
-
 
6422
    {$ENDIF}
3793
    FNowOptions := FNowOptions - DXDrawOptions3D;
6423
    FNowOptions := FNowOptions - DXDrawOptions3D;
3794
    if idoHardware in AOptions then FNowOptions := FNowOptions + [doHardware];
6424
    if idoHardware in AOptions then FNowOptions := FNowOptions + [doHardware];
3795
    if idoRetainedMode in AOptions then FNowOptions := FNowOptions + [doRetainedMode];
6425
    {$IFDEF D3DRM}if idoRetainedMode in AOptions then FNowOptions := FNowOptions + [doRetainedMode];{$ENDIF}
3796
    if idoSelectDriver in AOptions then FNowOptions := FNowOptions + [doSelectDriver];
6426
    if idoSelectDriver in AOptions then FNowOptions := FNowOptions + [doSelectDriver];
3797
    if idoZBuffer in AOptions then FNowOptions := FNowOptions + [doZBuffer];
6427
    if idoZBuffer in AOptions then FNowOptions := FNowOptions + [doZBuffer];
3798
  end;
6428
  end;
3799
end;
6429
end;
3800
 
6430
 
Line 3807... Line 6437...
3807
 
6437
 
3808
procedure TDXDrawDriver.Finalize;
6438
procedure TDXDrawDriver.Finalize;
3809
begin
6439
begin
3810
  with FDXDraw do
6440
  with FDXDraw do
3811
  begin
6441
  begin
-
 
6442
    {$IFDEF D3DRM}
3812
    FViewport := nil;
6443
    FViewport := nil;
3813
    FCamera := nil;
6444
    FCamera := nil;
3814
    FScene := nil;
6445
    FScene := nil;
3815
 
6446
 
3816
    FD3DRMDevice := nil;
6447
    FD3DRMDevice := nil;
3817
    FD3DRMDevice2 := nil;
6448
    FD3DRMDevice2 := nil;
3818
    FD3DRMDevice3 := nil;
6449
    FD3DRMDevice3 := nil;
-
 
6450
    FD3DRM3 := nil;
-
 
6451
    FD3DRM2 := nil;
-
 
6452
    FD3DRM := nil;
-
 
6453
    {$ENDIF}
-
 
6454
    {$IFDEF D3D_deprecated}
3819
    FD3DDevice := nil;
6455
    FD3DDevice := nil;
3820
    FD3DDevice2 := nil;
6456
    FD3DDevice2 := nil;
3821
    FD3DDevice3 := nil;
6457
    FD3DDevice3 := nil;
-
 
6458
    {$ENDIF}
3822
    FD3DDevice7 := nil;
6459
    FD3DDevice7 := nil;
-
 
6460
    {$IFDEF D3D_deprecated}
3823
    FD3D := nil;
6461
    FD3D := nil;
3824
    FD3D2 := nil;
6462
    FD3D2 := nil;
3825
    FD3D3 := nil;
6463
    FD3D3 := nil;
-
 
6464
    {$ENDIF}
3826
    FD3D7 := nil;
6465
    FD3D7 := nil;
3827
 
6466
 
3828
    FreeZBufferSurface(FSurface, FZBuffer);
6467
    FreeZBufferSurface(FSurface, FZBuffer);
3829
 
6468
 
3830
    FClipper.Free;  FClipper := nil;
6469
    FClipper.Free; FClipper := nil;
3831
    FPalette.Free;  FPalette := nil;
6470
    FPalette.Free; FPalette := nil;
3832
    FSurface.Free;  FSurface := nil;
6471
    FSurface.Free; FSurface := nil;
3833
    FPrimary.Free;  FPrimary := nil;
6472
    FPrimary.Free; FPrimary := nil;
3834
 
6473
 
3835
    FD3DRM3 := nil;
-
 
3836
    FD3DRM2 := nil;
-
 
3837
    FD3DRM := nil;
-
 
3838
  end;
6474
  end;
3839
end;
6475
end;
3840
 
6476
 
3841
function TDXDrawDriver.Restore: Boolean;
6477
function TDXDrawDriver.Restore: Boolean;
3842
begin
6478
begin
Line 3865... Line 6501...
3865
  Result := RGBQuadsToPaletteEntries(RGBQuads);
6501
  Result := RGBQuadsToPaletteEntries(RGBQuads);
3866
 
6502
 
3867
  if not AllowPalette256 then
6503
  if not AllowPalette256 then
3868
  begin
6504
  begin
3869
    dc := GetDC(0);
6505
    dc := GetDC(0);
-
 
6506
    try
3870
    GetSystemPaletteEntries(dc, 0, 256, Entries);
6507
      GetSystemPaletteEntries(dc, 0, 256, Entries);
-
 
6508
    finally
3871
    ReleaseDC(0, dc);
6509
      ReleaseDC(0, dc);
-
 
6510
    end;
3872
 
6511
 
3873
    for i:=0 to 9 do
6512
    for i := 0 to 9 do
3874
      Result[i] := Entries[i];
6513
      Result[i] := Entries[i];
3875
 
6514
 
3876
    for i:=256-10 to 255 do
6515
    for i := 256 - 10 to 255 do
3877
      Result[i] := Entries[i];
6516
      Result[i] := Entries[i];
3878
  end;
6517
  end;
3879
 
6518
 
3880
  for i:=0 to 255 do
6519
  for i := 0 to 255 do
3881
    Result[i].peFlags := D3DPAL_READONLY;
6520
    Result[i].peFlags := D3DPAL_READONLY;
3882
end;
6521
end;
3883
 
6522
 
3884
procedure TDXDrawDriverBlt.Flip;
6523
procedure TDXDrawDriverBlt.Flip;
3885
var
6524
var
Line 3894... Line 6533...
3894
    Dest := Bounds(pt.x, pt.y, FDXDraw.Width, FDXDraw.Height);
6533
    Dest := Bounds(pt.x, pt.y, FDXDraw.Width, FDXDraw.Height);
3895
  end else
6534
  end else
3896
  begin
6535
  begin
3897
    if doCenter in FDXDraw.NowOptions then
6536
    if doCenter in FDXDraw.NowOptions then
3898
    begin
6537
    begin
3899
      Inc(pt.x, (FDXDraw.Width-FDXDraw.FSurface.Width) div 2);
6538
      Inc(pt.x, (FDXDraw.Width - FDXDraw.FSurface.Width) div 2);
3900
      Inc(pt.y, (FDXDraw.Height-FDXDraw.FSurface.Height) div 2);
6539
      Inc(pt.y, (FDXDraw.Height - FDXDraw.FSurface.Height) div 2);
3901
    end;
6540
    end;
3902
 
6541
 
3903
    Dest := Bounds(pt.x, pt.y, FDXDraw.FSurface.Width, FDXDraw.FSurface.Height);
6542
    Dest := Bounds(pt.x, pt.y, FDXDraw.FSurface.Width, FDXDraw.FSurface.Height);
3904
  end;
6543
  end;
3905
 
6544
 
3906
  if doWaitVBlank in FDXDraw.NowOptions then
6545
  if doWaitVBlank in FDXDraw.NowOptions then
3907
    FDXDraw.FDDraw.DXResult := FDXDraw.FDDraw.IDraw.WaitForVerticalBlank(DDWAITVB_BLOCKBEGIN, 0);
6546
    FDXDraw.FDDraw.DXResult := FDXDraw.FDDraw.{$IFDEF D3D_deprecated}IDraw{$ELSE}IDraw7{$ENDIF}.WaitForVerticalBlank(DDWAITVB_BLOCKBEGIN, 0);
3908
 
6547
 
-
 
6548
  FillChar(DF, SizeOf(DF), 0);
3909
  DF.dwsize := SizeOf(DF);
6549
  DF.dwsize := SizeOf(DF);
3910
  DF.dwDDFX := 0;
6550
  DF.dwDDFX := 0;
3911
 
6551
 
3912
  FDXDraw.FPrimary.Blt(Dest, FDXDraw.FSurface.ClientRect, DDBLT_WAIT, df, FDXDraw.FSurface);
6552
  FDXDraw.FPrimary.Blt(Dest, FDXDraw.FSurface.ClientRect, DDBLT_WAIT, df, FDXDraw.FSurface);
3913
end;
6553
end;
3914
 
6554
 
3915
procedure TDXDrawDriverBlt.Initialize;
6555
procedure TDXDrawDriverBlt.Initialize;
-
 
6556
{$IFDEF D3D_deprecated}
3916
const
6557
const
3917
  PrimaryDesc: TDDSurfaceDesc = (
6558
  PrimaryDesc: TDDSurfaceDesc = (
3918
      dwSize: SizeOf(PrimaryDesc);
6559
    dwSize: SizeOf(PrimaryDesc);
3919
      dwFlags: DDSD_CAPS;
6560
    dwFlags: DDSD_CAPS;
3920
      ddsCaps: (dwCaps: DDSCAPS_PRIMARYSURFACE)
6561
    ddsCaps: (dwCaps: DDSCAPS_PRIMARYSURFACE)
3921
      );
6562
    );
-
 
6563
{$ENDIF}
3922
var
6564
var
3923
  Entries: TPaletteEntries;
6565
  Entries: TPaletteEntries;
3924
  PaletteCaps: Integer;
6566
  PaletteCaps: Integer;
-
 
6567
  {$IFNDEF D3D_deprecated}
-
 
6568
  PrimaryDesc: TDDSurfaceDesc2;
-
 
6569
  {$ENDIF}
3925
begin
6570
begin
-
 
6571
  {$IFNDEF D3D_deprecated}
-
 
6572
  FillChar(PrimaryDesc, SizeOf(PrimaryDesc), 0);
-
 
6573
  PrimaryDesc.dwSize := SizeOf(PrimaryDesc);
-
 
6574
  PrimaryDesc.dwFlags := DDSD_CAPS;
-
 
6575
  PrimaryDesc.ddsCaps.dwCaps := DDSCAPS_PRIMARYSURFACE;
-
 
6576
  {$ENDIF}
3926
  {  Surface making  }
6577
  {  Surface making  }
3927
  FDXDraw.FPrimary := TDirectDrawSurface.Create(FDXDraw.FDDraw);
6578
  FDXDraw.FPrimary := TDirectDrawSurface.Create(FDXDraw.FDDraw);
3928
  if not FDXDraw.FPrimary.CreateSurface(PrimaryDesc) then
6579
  if not FDXDraw.FPrimary.CreateSurface(PrimaryDesc) then
3929
    raise EDXDrawError.CreateFmt(SCannotMade, [SDirectDrawPrimarySurface]);
6580
    raise EDXDrawError.CreateFmt(SCannotMade, [SDirectDrawPrimarySurface]);
3930
 
6581
 
Line 3950... Line 6601...
3950
  InitializeSurface;
6601
  InitializeSurface;
3951
end;
6602
end;
3952
 
6603
 
3953
procedure TDXDrawDriverBlt.InitializeSurface;
6604
procedure TDXDrawDriverBlt.InitializeSurface;
3954
var
6605
var
3955
  ddsd: TDDSurfaceDesc;
6606
  ddsd: {$IFDEF D3D_deprecated}TDDSurfaceDesc{$ELSE}TDDSurfaceDesc2{$ENDIF};
3956
begin
6607
begin
3957
  FDXDraw.FSurface.IDDSurface := nil;
6608
  FDXDraw.FSurface.{$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF} := nil;
3958
 
6609
 
3959
  {  Surface making  }
6610
  {  Surface making  }
3960
  FDXDraw.FNowOptions := FDXDraw.FNowOptions - [doSystemMemory];
6611
  FDXDraw.FNowOptions := FDXDraw.FNowOptions - [doSystemMemory];
3961
 
6612
 
3962
  FillChar(ddsd, SizeOf(ddsd), 0);
6613
  FillChar(ddsd, SizeOf(ddsd), 0);
Line 3967... Line 6618...
3967
    dwWidth := Max(FDXDraw.FSurfaceWidth, 1);
6618
    dwWidth := Max(FDXDraw.FSurfaceWidth, 1);
3968
    dwHeight := Max(FDXDraw.FSurfaceHeight, 1);
6619
    dwHeight := Max(FDXDraw.FSurfaceHeight, 1);
3969
    ddsCaps.dwCaps := DDSCAPS_OFFSCREENPLAIN;
6620
    ddsCaps.dwCaps := DDSCAPS_OFFSCREENPLAIN;
3970
    if doSystemMemory in FDXDraw.Options then
6621
    if doSystemMemory in FDXDraw.Options then
3971
      ddsCaps.dwCaps := ddsCaps.dwCaps or DDSCAPS_SYSTEMMEMORY;
6622
      ddsCaps.dwCaps := ddsCaps.dwCaps or DDSCAPS_SYSTEMMEMORY;
3972
    if do3D in FDXDraw.FNowOptions then
6623
    {$IFDEF D3D_deprecated}if do3D in FDXDraw.FNowOptions then{$ENDIF}
3973
      ddsCaps.dwCaps := ddsCaps.dwCaps or DDSCAPS_3DDEVICE;
6624
      ddsCaps.dwCaps := ddsCaps.dwCaps or DDSCAPS_3DDEVICE;
3974
  end;
6625
  end;
3975
 
6626
 
3976
  if not FDXDraw.FSurface.CreateSurface(ddsd) then
6627
  if not FDXDraw.FSurface.CreateSurface(ddsd) then
3977
  begin
6628
  begin
3978
    ddsd.ddsCaps.dwCaps := ddsd.ddsCaps.dwCaps or DDSCAPS_SYSTEMMEMORY;
6629
    ddsd.ddsCaps.dwCaps := ddsd.ddsCaps.dwCaps or DDSCAPS_SYSTEMMEMORY;
3979
    if not FDXDraw.FSurface.CreateSurface(ddsd) then
6630
    if not FDXDraw.FSurface.CreateSurface(ddsd) then
3980
      raise EDXDrawError.CreateFmt(SCannotMade, [SDirectDrawSurface]);
6631
      raise EDXDrawError.CreateFmt(SCannotMade, [SDirectDrawSurface]);
3981
  end;
6632
  end;
3982
 
6633
 
3983
  if FDXDraw.FSurface.SurfaceDesc.ddscaps.dwCaps and DDSCAPS_VIDEOMEMORY=0 then
6634
  if FDXDraw.FSurface.SurfaceDesc.ddscaps.dwCaps and DDSCAPS_VIDEOMEMORY = 0 then
3984
    FDXDraw.FNowOptions := FDXDraw.FNowOptions + [doSystemMemory];
6635
    FDXDraw.FNowOptions := FDXDraw.FNowOptions + [doSystemMemory];
3985
 
6636
 
3986
  FDXDraw.FSurface.Palette := FDXDraw.Palette;
6637
  FDXDraw.FSurface.Palette := FDXDraw.Palette;
3987
  FDXDraw.FSurface.Fill(0);
6638
  FDXDraw.FSurface.Fill(0);
3988
 
6639
 
3989
  if do3D in FDXDraw.FNowOptions then
6640
  {$IFDEF D3D_deprecated}if do3D in FDXDraw.FNowOptions then{$ENDIF}
3990
    Initialize3D;
6641
    Initialize3D;
3991
end;
6642
end;
3992
 
6643
 
3993
function TDXDrawDriverBlt.SetSize(AWidth, AHeight: Integer): Boolean;
6644
function TDXDrawDriverBlt.SetSize(AWidth, AHeight: Integer): Boolean;
3994
begin
6645
begin
Line 4003... Line 6654...
4003
 
6654
 
4004
    if FDXDraw.FCalledDoInitializeSurface then
6655
    if FDXDraw.FCalledDoInitializeSurface then
4005
    begin
6656
    begin
4006
      FDXDraw.FCalledDoInitializeSurface := False;
6657
      FDXDraw.FCalledDoInitializeSurface := False;
4007
      FDXDraw.DoFinalizeSurface;
6658
      FDXDraw.DoFinalizeSurface;
4008
    end;                    
6659
    end;
4009
   
6660
 
4010
    InitializeSurface;
6661
    InitializeSurface;
4011
 
6662
 
4012
    FDXDraw.NotifyEventList(dxntInitializeSurface);
6663
    FDXDraw.NotifyEventList(dxntInitializeSurface);
4013
    FDXDraw.FCalledDoInitializeSurface := True; FDXDraw.DoInitializeSurface;
6664
    FDXDraw.FCalledDoInitializeSurface := True; FDXDraw.DoInitializeSurface;
4014
  finally
6665
  finally
Line 4017... Line 6668...
4017
end;
6668
end;
4018
 
6669
 
4019
{  TDXDrawDriverFlip  }
6670
{  TDXDrawDriverFlip  }
4020
 
6671
 
4021
procedure TDXDrawDriverFlip.Flip;
6672
procedure TDXDrawDriverFlip.Flip;
4022
begin                                        
6673
begin
4023
  if (FDXDraw.FForm<>nil) and (FDXDraw.FForm.Active) then
6674
  if (FDXDraw.FForm <> nil) and (FDXDraw.FForm.Active) then
4024
    FDXDraw.FPrimary.DXResult := FDXDraw.FPrimary.ISurface.Flip(nil, DDFLIP_WAIT)
6675
    FDXDraw.FPrimary.DXResult := FDXDraw.FPrimary.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}.Flip(nil, DDFLIP_WAIT)
4025
  else
6676
  else
4026
    FDXDraw.FPrimary.DXResult := 0;
6677
    FDXDraw.FPrimary.DXResult := 0;
4027
end;
6678
end;
4028
 
6679
 
4029
procedure TDXDrawDriverFlip.Initialize;
6680
procedure TDXDrawDriverFlip.Initialize;
-
 
6681
{$IFDEF D3D_deprecated}
4030
const
6682
const
4031
  DefPrimaryDesc: TDDSurfaceDesc = (
6683
  DefPrimaryDesc: TDDSurfaceDesc = (
4032
      dwSize: SizeOf(DefPrimaryDesc);
6684
    dwSize: SizeOf(DefPrimaryDesc);
4033
      dwFlags: DDSD_CAPS or DDSD_BACKBUFFERCOUNT;
6685
    dwFlags: DDSD_CAPS or DDSD_BACKBUFFERCOUNT;
4034
      dwBackBufferCount: 1;
6686
    dwBackBufferCount: 1;
4035
      ddsCaps: (dwCaps: DDSCAPS_PRIMARYSURFACE or DDSCAPS_FLIP or DDSCAPS_COMPLEX)
6687
    ddsCaps: (dwCaps: DDSCAPS_PRIMARYSURFACE or DDSCAPS_FLIP or DDSCAPS_COMPLEX)
4036
      );
6688
    );
4037
  BackBufferCaps: TDDSCaps = (dwCaps: DDSCAPS_BACKBUFFER);
6689
  BackBufferCaps: TDDSCaps = (dwCaps: DDSCAPS_BACKBUFFER);
-
 
6690
{$ENDIF}
4038
var
6691
var
4039
  PrimaryDesc: TDDSurfaceDesc;
6692
  PrimaryDesc: {$IFDEF D3D_deprecated}TDDSurfaceDesc{$ELSE}TDDSurfaceDesc2{$ENDIF};
4040
  PaletteCaps: Integer;
6693
  PaletteCaps: Integer;
4041
  Entries: TPaletteEntries;
6694
  Entries: TPaletteEntries;
-
 
6695
  DDSurface: {$IFDEF D3D_deprecated}IDirectDrawSurface{$ELSE}IDirectDrawSurface7{$ENDIF};
-
 
6696
  {$IFNDEF D3D_deprecated}
4042
  DDSurface: IDirectDrawSurface;
6697
  BackBufferCaps: TDDSCaps2;
-
 
6698
  {$ENDIF}
4043
begin
6699
begin
4044
  {  Surface making  }
6700
  {  Surface making  }
-
 
6701
  {$IFDEF D3D_deprecated}
4045
  PrimaryDesc := DefPrimaryDesc;
6702
  PrimaryDesc := DefPrimaryDesc;
4046
 
6703
  {$ELSE}
-
 
6704
  FillChar(PrimaryDesc, SizeOf(PrimaryDesc), 0);
-
 
6705
  PrimaryDesc.dwSize := SizeOf(PrimaryDesc);
-
 
6706
  PrimaryDesc.dwFlags := DDSD_CAPS or DDSD_BACKBUFFERCOUNT;
-
 
6707
  PrimaryDesc.dwBackBufferCount := 1;
-
 
6708
  PrimaryDesc.ddsCaps.dwCaps := DDSCAPS_PRIMARYSURFACE or DDSCAPS_FLIP or DDSCAPS_COMPLEX;
-
 
6709
  FillChar(BackBufferCaps, SizeOf(BackBufferCaps), 0);
-
 
6710
  BackBufferCaps.dwCaps := DDSCAPS_BACKBUFFER;
-
 
6711
  {$ENDIF}
4047
  if do3D in FDXDraw.FNowOptions then
6712
  {$IFDEF D3D_deprecated}if do3D in FDXDraw.FNowOptions then{$ENDIF}
4048
    PrimaryDesc.ddsCaps.dwCaps := PrimaryDesc.ddsCaps.dwCaps or DDSCAPS_3DDEVICE;
6713
    PrimaryDesc.ddsCaps.dwCaps := PrimaryDesc.ddsCaps.dwCaps or DDSCAPS_3DDEVICE;
4049
 
6714
 
4050
  FDXDraw.FPrimary := TDirectDrawSurface.Create(FDXDraw.FDDraw);
6715
  FDXDraw.FPrimary := TDirectDrawSurface.Create(FDXDraw.FDDraw);
4051
  if not FDXDraw.FPrimary.CreateSurface(PrimaryDesc) then
6716
  if not FDXDraw.FPrimary.CreateSurface(PrimaryDesc) then
4052
    raise EDXDrawError.CreateFmt(SCannotMade, [SDirectDrawPrimarySurface]);
6717
    raise EDXDrawError.CreateFmt(SCannotMade, [SDirectDrawPrimarySurface]);
4053
 
6718
 
4054
  FDXDraw.FSurface := TDirectDrawSurface.Create(FDXDraw.FDDraw);
6719
  FDXDraw.FSurface := TDirectDrawSurface.Create(FDXDraw.FDDraw);
4055
  if FDXDraw.FPrimary.ISurface.GetAttachedSurface(BackBufferCaps, DDSurface)=DD_OK then
6720
  if FDXDraw.FPrimary.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}.GetAttachedSurface(BackBufferCaps, DDSurface) = DD_OK then
4056
    FDXDraw.FSurface.IDDSurface := DDSurface;
6721
    FDXDraw.FSurface.{$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF} := DDSurface;
4057
 
6722
 
4058
  FDXDraw.FNowOptions := FDXDraw.FNowOptions - [doSystemMemory];
6723
  FDXDraw.FNowOptions := FDXDraw.FNowOptions - [doSystemMemory];
4059
  if FDXDraw.FSurface.SurfaceDesc.ddscaps.dwCaps and DDSCAPS_SYSTEMMEMORY<>0 then
6724
  if FDXDraw.FSurface.SurfaceDesc.ddscaps.dwCaps and DDSCAPS_SYSTEMMEMORY <> 0 then
4060
    FDXDraw.FNowOptions := FDXDraw.FNowOptions + [doSystemMemory];
6725
    FDXDraw.FNowOptions := FDXDraw.FNowOptions + [doSystemMemory];
4061
 
6726
 
4062
  {  Clipper making of dummy  }
6727
  {  Clipper making of dummy  }
4063
  FDXDraw.FClipper := TDirectDrawClipper.Create(FDXDraw.FDDraw);
6728
  FDXDraw.FClipper := TDirectDrawClipper.Create(FDXDraw.FDDraw);
4064
 
6729
 
Line 4069... Line 6734...
4069
 
6734
 
4070
  FDXDraw.FPalette := TDirectDrawPalette.Create(FDXDraw.FDDraw);
6735
  FDXDraw.FPalette := TDirectDrawPalette.Create(FDXDraw.FDDraw);
4071
  Entries := TDXDrawRGBQuadsToPaletteEntries(FDXDraw.ColorTable,
6736
  Entries := TDXDrawRGBQuadsToPaletteEntries(FDXDraw.ColorTable,
4072
    doAllowPalette256 in FDXDraw.NowOptions);
6737
    doAllowPalette256 in FDXDraw.NowOptions);
4073
  FDXDraw.FPalette.CreatePalette(PaletteCaps, Entries);
6738
  FDXDraw.FPalette.CreatePalette(PaletteCaps, Entries);
4074
                         
-
 
-
 
6739
 
4075
  FDXDraw.FPrimary.Palette := FDXDraw.Palette;
6740
  FDXDraw.FPrimary.Palette := FDXDraw.Palette;
4076
  FDXDraw.FSurface.Palette := FDXDraw.Palette;
6741
  FDXDraw.FSurface.Palette := FDXDraw.Palette;
4077
 
6742
 
4078
  if do3D in FDXDraw.FNowOptions then
6743
  {$IFDEF D3D_deprecated}if do3D in FDXDraw.FNowOptions then{$ENDIF}
4079
    Initialize3D;
6744
    Initialize3D;
-
 
6745
 
4080
end;
6746
end;
4081
 
6747
 
4082
constructor TCustomDXDraw.Create(AOwner: TComponent);
6748
constructor TCustomDXDraw.Create(AOwner: TComponent);
4083
var
6749
var
4084
  Entries: TPaletteEntries;
6750
  Entries: TPaletteEntries;
Line 4086... Line 6752...
4086
begin
6752
begin
4087
  FNotifyEventList := TList.Create;
6753
  FNotifyEventList := TList.Create;
4088
  inherited Create(AOwner);
6754
  inherited Create(AOwner);
4089
  FAutoInitialize := True;
6755
  FAutoInitialize := True;
4090
  FDisplay := TDXDrawDisplay.Create(Self);
6756
  FDisplay := TDXDrawDisplay.Create(Self);
4091
 
-
 
-
 
6757
  {$IFDEF _DMO_}FAdapters := EnumDirectDrawDriversEx;{$ENDIF}
4092
  Options := [doAllowReboot, doWaitVBlank, doCenter, doDirectX7Mode, doHardware, doSelectDriver];
6758
  Options := [doAllowReboot, doWaitVBlank, doCenter, {$IFDEF D3D_deprecated}doDirectX7Mode, do3D,{$ENDIF}
-
 
6759
    doHardware, doSelectDriver];
4093
 
6760
 
4094
  FAutoSize := True;
6761
  FAutoSize := True;
4095
 
6762
 
4096
  dc := GetDC(0);
6763
  dc := GetDC(0);
-
 
6764
  try
4097
  GetSystemPaletteEntries(dc, 0, 256, Entries);
6765
    GetSystemPaletteEntries(dc, 0, 256, Entries);
-
 
6766
  finally
4098
  ReleaseDC(0, dc);
6767
    ReleaseDC(0, dc);
-
 
6768
  end;
4099
 
6769
 
4100
  ColorTable := PaletteEntriesToRGBQuads(Entries);
6770
  ColorTable := PaletteEntriesToRGBQuads(Entries);
4101
  DefColorTable := ColorTable;
6771
  DefColorTable := ColorTable;
4102
 
6772
 
4103
  Width := 100;
6773
  Width := 100;
4104
  Height := 100;
6774
  Height := 100;
4105
  ParentColor := False;
6775
  ParentColor := False;
4106
  Color := clBtnFace;
6776
  Color := clBlack; //clBtnFace; // FIX
-
 
6777
 
-
 
6778
  FD2D := TD2D.Create(Self);
-
 
6779
  D2D := FD2D; {as loopback}
-
 
6780
  FTraces := TTraces.Create(Self);
4107
end;
6781
end;
4108
 
6782
 
4109
destructor TCustomDXDraw.Destroy;
6783
destructor TCustomDXDraw.Destroy;
4110
begin
6784
begin
4111
  Finalize;
6785
  Finalize;
4112
  NotifyEventList(dxntDestroying);
6786
  NotifyEventList(dxntDestroying);
4113
  FDisplay.Free;
6787
  FDisplay.Free;
-
 
6788
  {$IFDEF _DMO_}FAdapters := nil;{$ENDIF}
4114
  FSubClass.Free; FSubClass := nil;
6789
  FSubClass.Free; FSubClass := nil;
4115
  FNotifyEventList.Free;
6790
  FNotifyEventList.Free;
-
 
6791
  FD2D.Free;
-
 
6792
  FD2D := nil;
-
 
6793
  D2D := nil;
-
 
6794
  FTraces.Free;
4116
  inherited Destroy;
6795
  inherited Destroy;
4117
end;
6796
end;
4118
 
6797
 
4119
class function TCustomDXDraw.Drivers: TDirectXDrivers;
6798
class function TCustomDXDraw.Drivers: TDirectXDrivers;
4120
begin
6799
begin
4121
  Result := EnumDirectDrawDrivers;
6800
  Result := EnumDirectDrawDrivers;
4122
end;
6801
end;
4123
 
6802
 
-
 
6803
{$IFDEF _DMO_}
-
 
6804
class function TCustomDXDraw.DriversEx: TDirectXDriversEx;
-
 
6805
begin
-
 
6806
  Result := EnumDirectDrawDriversEx;
-
 
6807
end;
-
 
6808
{$ENDIF}
-
 
6809
 
4124
type
6810
type
4125
  PDXDrawNotifyEvent = ^TDXDrawNotifyEvent;
6811
  PDXDrawNotifyEvent = ^TDXDrawNotifyEvent;
4126
 
6812
 
4127
procedure TCustomDXDraw.RegisterNotifyEvent(NotifyEvent: TDXDrawNotifyEvent);
6813
procedure TCustomDXDraw.RegisterNotifyEvent(NotifyEvent: TDXDrawNotifyEvent);
4128
var
6814
var
Line 4139... Line 6825...
4139
  if Initialized then
6825
  if Initialized then
4140
  begin
6826
  begin
4141
    NotifyEvent(Self, dxntInitialize);
6827
    NotifyEvent(Self, dxntInitialize);
4142
    if FCalledDoInitializeSurface then
6828
    if FCalledDoInitializeSurface then
4143
      NotifyEvent(Self, dxntInitializeSurface);
6829
      NotifyEvent(Self, dxntInitializeSurface);
4144
    if FOffNotifyRestore=0 then
6830
    if FOffNotifyRestore = 0 then
4145
      NotifyEvent(Self, dxntRestore);
6831
      NotifyEvent(Self, dxntRestore);
4146
  end;
6832
  end;
4147
end;
6833
end;
4148
 
6834
 
4149
procedure TCustomDXDraw.UnRegisterNotifyEvent(NotifyEvent: TDXDrawNotifyEvent);
6835
procedure TCustomDXDraw.UnRegisterNotifyEvent(NotifyEvent: TDXDrawNotifyEvent);
4150
var
6836
var
4151
  Event: PDXDrawNotifyEvent;
6837
  Event: PDXDrawNotifyEvent;
4152
  i: Integer;
6838
  i: Integer;
4153
begin
6839
begin
4154
  for i:=0 to FNotifyEventList.Count-1 do
6840
  for i := 0 to FNotifyEventList.Count - 1 do
4155
  begin
6841
  begin
4156
    Event := FNotifyEventList[i];
6842
    Event := FNotifyEventList[i];
4157
    if (TMethod(Event^).Code = TMethod(NotifyEvent).Code) and
6843
    if (TMethod(Event^).Code = TMethod(NotifyEvent).Code) and
4158
      (TMethod(Event^).Data = TMethod(NotifyEvent).Data) then
6844
      (TMethod(Event^).Data = TMethod(NotifyEvent).Data) then
4159
    begin
6845
    begin
Line 4172... Line 6858...
4172
 
6858
 
4173
procedure TCustomDXDraw.NotifyEventList(NotifyType: TDXDrawNotifyType);
6859
procedure TCustomDXDraw.NotifyEventList(NotifyType: TDXDrawNotifyType);
4174
var
6860
var
4175
  i: Integer;
6861
  i: Integer;
4176
begin
6862
begin
4177
  for i:=FNotifyEventList.Count-1 downto 0 do
6863
  for i := FNotifyEventList.Count - 1 downto 0 do
4178
    PDXDrawNotifyEvent(FNotifyEventList[i])^(Self, NotifyType);
6864
    PDXDrawNotifyEvent(FNotifyEventList[i])^(Self, NotifyType);
4179
end;
6865
end;
4180
 
6866
 
4181
procedure TCustomDXDraw.FormWndProc(var Message: TMessage; DefWindowProc: TWndMethod);
6867
procedure TCustomDXDraw.FormWndProc(var Message: TMessage; DefWindowProc: TWndMethod);
4182
 
6868
 
4183
  procedure FlipToGDISurface;
6869
  procedure FlipToGDISurface;
4184
  begin
6870
  begin
4185
    if Initialized and (FNowOptions*[doFullScreen, doFlip]=[doFullScreen, doFlip]) then
6871
    if Initialized and (FNowOptions * [doFullScreen, doFlip] = [doFullScreen, doFlip]) then
4186
      DDraw.IDraw.FlipToGDISurface;
6872
      DDraw.{$IFDEF D3D_deprecated}IDraw{$ELSE}IDraw7{$ENDIF}.FlipToGDISurface;
4187
  end;
6873
  end;
4188
 
6874
 
4189
begin
6875
begin
4190
  case Message.Msg of
6876
  case Message.Msg of
4191
    {CM_ACTIVATE:
6877
    {CM_ACTIVATE:
Line 4194... Line 6880...
4194
          if AutoInitialize and (not FInitalized2) then
6880
          if AutoInitialize and (not FInitalized2) then
4195
            Initialize;
6881
            Initialize;
4196
          Exit;
6882
          Exit;
4197
        end;   }
6883
        end;   }
4198
    WM_WINDOWPOSCHANGED:
6884
    WM_WINDOWPOSCHANGED:
-
 
6885
      begin
-
 
6886
        if TWMWindowPosChanged(Message).WindowPos^.flags and SWP_SHOWWINDOW <> 0 then
4199
        begin
6887
        begin
4200
          if TWMWindowPosChanged(Message).WindowPos^.flags and SWP_SHOWWINDOW<>0 then
-
 
4201
          begin
-
 
4202
            DefWindowProc(Message);
6888
          DefWindowProc(Message);
4203
            if AutoInitialize and (not FInitialized2) then
6889
          if AutoInitialize and (not FInitialized2) then
4204
              Initialize;
6890
            Initialize;
4205
            Exit;
6891
          Exit;
4206
          end;
-
 
4207
        end;
6892
        end;
-
 
6893
      end;
-
 
6894
(*
4208
    WM_ACTIVATE:
6895
    WM_ACTIVATEAPP:
-
 
6896
      begin
-
 
6897
        if TWMActivateApp(Message).Active then
4209
        begin
6898
        begin
4210
          if TWMActivate(Message).Active=WA_INACTIVE then
6899
          FActive := True;
4211
            FlipToGDISurface;
6900
          DoActivate;
-
 
6901
//          PostMessage(FHandle, CM_ACTIVATE, 0, 0)
4212
        end;
6902
        end
4213
    WM_INITMENU:
6903
        else
4214
        begin
6904
        begin
-
 
6905
          FActive := False;
4215
          FlipToGDISurface;
6906
          DoDeactivate;
-
 
6907
//          PostMessage(FHandle, CM_DEACTIVATE, 0, 0);
4216
        end;
6908
        end;
-
 
6909
      end;
-
 
6910
*)
-
 
6911
    WM_ACTIVATE:
-
 
6912
      begin
-
 
6913
        if TWMActivate(Message).Active = WA_INACTIVE then
-
 
6914
          FlipToGDISurface;
-
 
6915
      end;
-
 
6916
    WM_INITMENU:
-
 
6917
      begin
-
 
6918
        FlipToGDISurface;
-
 
6919
      end;
4217
    WM_DESTROY:
6920
    WM_DESTROY:
4218
        begin
6921
      begin
-
 
6922
        Finalize;
-
 
6923
      end;
-
 
6924
    WM_ENTERSIZEMOVE:
-
 
6925
      begin
-
 
6926
        if not (csLoading in ComponentState) then
4219
          Finalize;
6927
          Finalize;
-
 
6928
      end;
-
 
6929
    WM_EXITSIZEMOVE:
-
 
6930
      begin
-
 
6931
        if not (csLoading in ComponentState) then
-
 
6932
          Initialize;
-
 
6933
      end;
-
 
6934
//    SW_RESTORE, SW_MAXIMIZE:
-
 
6935
//        begin
-
 
6936
//          {force finalize/initialize loop}
-
 
6937
//          if not AutoInitialize or not (csLoading in ComponentState) then begin
-
 
6938
//            Finalize;
-
 
6939
//            Initialize;
-
 
6940
//          end;
4220
        end;
6941
//        end;
4221
  end;      
6942
  end;
4222
  DefWindowProc(Message);
6943
  DefWindowProc(Message);
4223
end;
6944
end;
4224
 
6945
 
4225
procedure TCustomDXDraw.DoFinalize;
6946
procedure TCustomDXDraw.DoFinalize;
4226
begin
6947
begin
Line 4232... Line 6953...
4232
  if Assigned(FOnFinalizeSurface) then FOnFinalizeSurface(Self);
6953
  if Assigned(FOnFinalizeSurface) then FOnFinalizeSurface(Self);
4233
end;
6954
end;
4234
 
6955
 
4235
procedure TCustomDXDraw.DoInitialize;
6956
procedure TCustomDXDraw.DoInitialize;
4236
begin
6957
begin
-
 
6958
  {$IFDEF _DMO_}
-
 
6959
  {erase items for following refresh}
-
 
6960
  if Assigned(FAdapters) then FAdapters.Clear;
-
 
6961
  EnumDirectDrawDriversEx;
-
 
6962
  {$ENDIF}
4237
  if Assigned(FOnInitialize) then FOnInitialize(Self);
6963
  if Assigned(FOnInitialize) then FOnInitialize(Self);
-
 
6964
  {$IFNDEF DXR_deprecated}
-
 
6965
   {$IFDEF D3D_deprecated}
-
 
6966
    if not (do3D in Options) then
-
 
6967
      Options := Options + [do3D];
-
 
6968
   {$ENDIF}
-
 
6969
  {$ENDIF}
4238
end;
6970
end;
4239
 
6971
 
4240
procedure TCustomDXDraw.DoInitializeSurface;
6972
procedure TCustomDXDraw.DoInitializeSurface;
4241
begin
6973
begin
-
 
6974
  {.06 added for better initialization}
-
 
6975
  if Assigned(FD2D) then
-
 
6976
    RenderError := FD2D.D2DInitializeSurface;
-
 
6977
 
4242
  if Assigned(FOnInitializeSurface) then FOnInitializeSurface(Self);
6978
  if Assigned(FOnInitializeSurface) then FOnInitializeSurface(Self);
4243
end;
6979
end;
4244
 
6980
 
4245
procedure TCustomDXDraw.DoInitializing;
6981
procedure TCustomDXDraw.DoInitializing;
4246
begin
6982
begin
Line 4292... Line 7028...
4292
 
7028
 
4293
      FDXDrawDriver.Free; FDXDrawDriver := nil;
7029
      FDXDrawDriver.Free; FDXDrawDriver := nil;
4294
      FUpdating := False;
7030
      FUpdating := False;
4295
    end;
7031
    end;
4296
  end;
7032
  end;
-
 
7033
  if AsSigned(FD2D) then
-
 
7034
    FD2D.Free;
-
 
7035
  FD2D := nil;
-
 
7036
  D2D := nil
4297
end;
7037
end;
4298
 
7038
 
4299
procedure TCustomDXDraw.Flip;
7039
procedure TCustomDXDraw.Flip;
4300
begin
7040
begin
4301
  if Initialized and (not FUpdating) then
7041
  if Initialized and (not FUpdating) then
4302
  begin
7042
  begin
4303
    if TryRestore then
7043
    if TryRestore and (not RenderError) then
4304
      TDXDrawDriver(FDXDrawDriver).Flip;
7044
      TDXDrawDriver(FDXDrawDriver).Flip;
4305
  end;
7045
  end;
-
 
7046
  RenderError := false;
4306
end;
7047
end;
4307
 
7048
 
4308
function TCustomDXDraw.GetCanDraw: Boolean;
7049
function TCustomDXDraw.GetCanDraw: Boolean;
4309
begin
7050
begin
-
 
7051
  {$IFNDEF DXR_deprecated}
-
 
7052
  {$IFDEF D3D_deprecated}
-
 
7053
  if not (do3D in Options) then
-
 
7054
    Options := Options + [do3D];
-
 
7055
  {$ENDIF}
-
 
7056
  {$ENDIF}
4310
  Result := Initialized and (not FUpdating) and (Surface.IDDSurface<>nil) and
7057
  Result := Initialized and (not FUpdating) and (Surface.{$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF} <> nil) and
4311
    TryRestore;
7058
    TryRestore;
4312
end;
7059
end;
4313
 
7060
 
4314
function TCustomDXDraw.GetCanPaletteAnimation: Boolean;
7061
function TCustomDXDraw.GetCanPaletteAnimation: Boolean;
4315
begin
7062
begin
4316
  Result := Initialized and (not FUpdating) and (doFullScreen in FNowOptions)
7063
  Result := Initialized and (not FUpdating) and (doFullScreen in FNowOptions)
4317
    and (DDraw.DisplayMode.ddpfPixelFormat.dwRGBBitCount<=8);
7064
    and (DDraw.DisplayMode.ddpfPixelFormat.dwRGBBitCount <= 8);
4318
end;
7065
end;
4319
 
7066
 
4320
function TCustomDXDraw.GetSurfaceHeight: Integer;
7067
function TCustomDXDraw.GetSurfaceHeight: Integer;
4321
begin
7068
begin
4322
  if Surface.IDDSurface<>nil then
7069
  if Surface.{$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF} <> nil then
4323
    Result := Surface.Height
7070
    Result := Surface.Height
4324
  else
7071
  else
4325
    Result := FSurfaceHeight;
7072
    Result := FSurfaceHeight;
4326
end;
7073
end;
4327
 
7074
 
4328
function TCustomDXDraw.GetSurfaceWidth: Integer;
7075
function TCustomDXDraw.GetSurfaceWidth: Integer;
4329
begin
7076
begin
4330
  if Surface.IDDSurface<>nil then
7077
  if Surface.{$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF} <> nil then
4331
    Result := Surface.Width
7078
    Result := Surface.Width
4332
  else
7079
  else
4333
    Result := FSurfaceWidth;
7080
    Result := FSurfaceWidth;
4334
end;
7081
end;
4335
 
7082
 
Line 4344... Line 7091...
4344
  end;
7091
  end;
4345
 
7092
 
4346
  NotifyEventList(dxntSetSurfaceSize);
7093
  NotifyEventList(dxntSetSurfaceSize);
4347
 
7094
 
4348
  if FAutoInitialize and (not (csDesigning in ComponentState)) then
7095
  if FAutoInitialize and (not (csDesigning in ComponentState)) then
4349
  begin                                      
7096
  begin
4350
    if {(not (doFullScreen in FOptions)) or }(FSubClass=nil) then
7097
    if {(not (doFullScreen in FOptions)) or }(FSubClass = nil) then
4351
      Initialize;
7098
      Initialize;
4352
  end;
7099
  end;
4353
end;
7100
end;
4354
 
7101
 
4355
procedure TCustomDXDraw.Initialize;
7102
procedure TCustomDXDraw.Initialize;
4356
begin
7103
begin
4357
  FInitialized2 := True;
7104
  FInitialized2 := True;
4358
 
7105
 
4359
  Finalize;
7106
  Finalize;
4360
 
7107
 
4361
  if FForm=nil then
7108
  if FForm = nil then
4362
    raise EDXDrawError.Create(SNoForm);
7109
    raise EDXDrawError.Create(SNoForm);
4363
 
7110
 
4364
  try
7111
  try
4365
    DoInitializing;
7112
    DoInitializing;
4366
 
7113
 
Line 4415... Line 7162...
4415
    FCalledDoInitializeSurface := True; DoInitializeSurface;
7162
    FCalledDoInitializeSurface := True; DoInitializeSurface;
4416
  finally
7163
  finally
4417
    Dec(FOffNotifyRestore);
7164
    Dec(FOffNotifyRestore);
4418
  end;
7165
  end;
4419
 
7166
 
-
 
7167
  if not Assigned(FD2D) then begin
-
 
7168
    FD2D := TD2D.Create(Self);
-
 
7169
    D2D := FD2D; {as loopback}
-
 
7170
  end;
-
 
7171
 
4420
  Restore;
7172
  Restore;
4421
end;
7173
end;
4422
 
7174
 
4423
procedure TCustomDXDraw.Paint;
7175
procedure TCustomDXDraw.Paint;
4424
var
7176
var
Line 4447... Line 7199...
4447
    w := Canvas.TextWidth(s);
7199
    w := Canvas.TextWidth(s);
4448
    h := Canvas.TextHeight(s);
7200
    h := Canvas.TextHeight(s);
4449
 
7201
 
4450
    Canvas.Brush.Style := bsSolid;
7202
    Canvas.Brush.Style := bsSolid;
4451
    Canvas.Brush.Color := clBtnFace;
7203
    Canvas.Brush.Color := clBtnFace;
4452
    Canvas.TextOut(Width div 2-w div 2, Height div 2-h div 2, s);
7204
    Canvas.TextOut(Width div 2 - w div 2, Height div 2 - h div 2, s);
4453
  end else
7205
  end else
4454
  begin
7206
  begin
4455
    Old := FNowOptions;
7207
    Old := FNowOptions;
4456
    try
7208
    try
4457
      FNowOptions := FNowOptions - [doWaitVBlank];
7209
      FNowOptions := FNowOptions - [doWaitVBlank];
4458
      Flip;
7210
      Flip;
4459
    finally        
7211
    finally
4460
      FNowOptions := Old;
7212
      FNowOptions := Old;
4461
    end;    
7213
    end;
4462
    if (Parent<>nil) and (Initialized) and (Surface.SurfaceDesc.ddscaps.dwCaps and DDSCAPS_VIDEOMEMORY<>0) then
7214
    if (Parent <> nil) and (Initialized) and (Surface.SurfaceDesc.ddscaps.dwCaps and DDSCAPS_VIDEOMEMORY <> 0) then
4463
      Parent.Invalidate;                                                                                
7215
      Parent.Invalidate;
4464
  end;
7216
  end;
4465
end;
7217
end;
4466
 
7218
 
4467
function TCustomDXDraw.PaletteChanged(Foreground: Boolean): Boolean;
7219
function TCustomDXDraw.PaletteChanged(Foreground: Boolean): Boolean;
4468
begin
7220
begin
Line 4472... Line 7224...
4472
    Result := True;
7224
    Result := True;
4473
  end else
7225
  end else
4474
    Result := False;
7226
    Result := False;
4475
end;
7227
end;
4476
 
7228
 
4477
procedure TCustomDXDraw.Render;
7229
procedure TCustomDXDraw.Render(LagCount: Integer{$IFDEF VER4UP} = 0{$ENDIF});
-
 
7230
var I: Integer;
4478
begin
7231
begin
-
 
7232
{$IFDEF D3DRM}
4479
  if FInitialized and (do3D in FNowOptions) and (doRetainedMode in FNowOptions) then
7233
  if FInitialized and {$IFDEF D3D_deprecated}(do3D in FNowOptions) and{$ENDIF} (doRetainedMode in FNowOptions) then
4480
  begin
7234
  begin
4481
    asm FInit end;
7235
    asm FInit end;
4482
    FViewport.Clear;
7236
    FViewport.Clear;
4483
    FViewport.Render(FScene);
7237
    FViewport.Render(FScene);
4484
    FD3DRMDevice.Update;
7238
    FD3DRMDevice.Update;
4485
    asm FInit end;
7239
    asm FInit end;
4486
  end;
7240
  end;
-
 
7241
{$ENDIF}
-
 
7242
  {traces}
-
 
7243
  if FTraces.Count > 0 then
-
 
7244
    for I := 0 to FTraces.Count - 1 do
-
 
7245
      if FTraces.Items[I].Active then
-
 
7246
        FTraces.Items[I].Render(LagCount);
-
 
7247
  {own rendering event}
-
 
7248
  if Assigned(FOnRender) then
-
 
7249
    FOnRender(Self);
4487
end;
7250
end;
4488
 
7251
 
4489
procedure TCustomDXDraw.Restore;
7252
procedure TCustomDXDraw.Restore;
4490
begin
7253
begin
4491
  if Initialized and (not FUpdating) then
7254
  if Initialized and (not FUpdating) then
Line 4508... Line 7271...
4508
  end;
7271
  end;
4509
end;
7272
end;
4510
 
7273
 
4511
procedure TCustomDXDraw.SetAutoSize(Value: Boolean);
7274
procedure TCustomDXDraw.SetAutoSize(Value: Boolean);
4512
begin
7275
begin
4513
  if FAutoSize<>Value then
7276
  if FAutoSize <> Value then
4514
  begin
7277
  begin
4515
    FAutoSize := Value;
7278
    FAutoSize := Value;
4516
    if FAutoSize then
7279
    if FAutoSize then
4517
      SetSize(Width, Height);
7280
      SetSize(Width, Height);
4518
  end;
7281
  end;
Line 4523... Line 7286...
4523
  inherited SetBounds(ALeft, ATop, AWidth, AHeight);
7286
  inherited SetBounds(ALeft, ATop, AWidth, AHeight);
4524
  if FAutoSize and (not FUpdating) then
7287
  if FAutoSize and (not FUpdating) then
4525
    SetSize(AWidth, AHeight);
7288
    SetSize(AWidth, AHeight);
4526
end;
7289
end;
4527
 
7290
 
-
 
7291
procedure TCustomDXDraw.BeginScene;
-
 
7292
begin
-
 
7293
  if CheckD3 then
-
 
7294
    FD2D.BeginScene
-
 
7295
end;
-
 
7296
 
-
 
7297
procedure TCustomDXDraw.EndScene;
-
 
7298
begin
-
 
7299
  if CheckD3 then
-
 
7300
    FD2D.EndScene
-
 
7301
end;
-
 
7302
 
-
 
7303
function TCustomDXDraw.CheckD3: Boolean;
-
 
7304
begin
-
 
7305
  Result := {$IFDEF D3D_deprecated}(do3D in Options) and{$ENDIF} (doHardware in Options) and AsSigned(FD2D);
-
 
7306
end;
-
 
7307
 
-
 
7308
function TCustomDXDraw.CheckD3D(Dest: TDirectDrawSurface): Boolean;
-
 
7309
begin
-
 
7310
  Result := CheckD3 and (FD2D.FDDraw.FSurface = Dest)
-
 
7311
end;
-
 
7312
 
-
 
7313
procedure TCustomDXDraw.ClearStack;
-
 
7314
begin
-
 
7315
  if CheckD3 then
-
 
7316
    FD2D.D2DTextures.D2DPruneAllTextures;
-
 
7317
end;
-
 
7318
 
-
 
7319
procedure TCustomDXDraw.UpdateTextures;
-
 
7320
var Changed: Boolean;
-
 
7321
begin
-
 
7322
  if CheckD3 then begin
-
 
7323
    if Assigned(FOnUpdateTextures) then begin
-
 
7324
      Changed := False;
-
 
7325
      FOnUpdateTextures(FD2D.FD2DTexture, Changed);
-
 
7326
      if Changed then FD2D.D2DUpdateTextures;
-
 
7327
    end
-
 
7328
  end;
-
 
7329
end;
-
 
7330
 
-
 
7331
procedure TCustomDXDraw.TextureFilter(Grade: TD2DTextureFilter);
-
 
7332
begin
-
 
7333
  if CheckD3 then
-
 
7334
    FD2D.TextureFilter := Grade;
-
 
7335
end;
-
 
7336
 
-
 
7337
procedure TCustomDXDraw.AntialiasFilter(Grade: TD3DAntialiasMode);
-
 
7338
begin
-
 
7339
  if CheckD3 then
-
 
7340
    FD2D.AntialiasFilter := Grade;
-
 
7341
end;
-
 
7342
 
-
 
7343
// ***** fade effects
-
 
7344
// do not use in dxtimer cycle
-
 
7345
 
-
 
7346
function TCustomDXDraw.Fade2Color(colorfrom, colorto: LongInt): LongInt;
-
 
7347
var i, r1, r2, g1, g2, b1, b2: Integer;
-
 
7348
begin
-
 
7349
  r1 := GetRValue(colorfrom);
-
 
7350
  r2 := GetRValue(colorto);
-
 
7351
  g1 := GetGValue(colorfrom);
-
 
7352
  g2 := GetGValue(colorto);
-
 
7353
  b1 := GetBValue(colorfrom);
-
 
7354
  b2 := GetBValue(colorto);
-
 
7355
  if r1 < r2 then
-
 
7356
  begin
-
 
7357
    for i := r1 to r2 do
-
 
7358
    begin
-
 
7359
      Surface.Fill(RGB(i, g1, b1));
-
 
7360
      Flip;
-
 
7361
    end;
-
 
7362
  end
-
 
7363
  else
-
 
7364
  begin
-
 
7365
    for i := r1 downto r2 do
-
 
7366
    begin
-
 
7367
      Surface.Fill(RGB(i, g1, b1));
-
 
7368
      Flip;
-
 
7369
    end;
-
 
7370
  end;
-
 
7371
 
-
 
7372
  if g1 < g2 then
-
 
7373
  begin
-
 
7374
    for i := g1 to g2 do
-
 
7375
    begin
-
 
7376
      Surface.Fill(RGB(r2, i, b1));
-
 
7377
      Flip;
-
 
7378
    end;
-
 
7379
  end
-
 
7380
  else
-
 
7381
  begin
-
 
7382
    for i := g1 downto g2 do
-
 
7383
    begin
-
 
7384
      Surface.Fill(RGB(r2, i, b1));
-
 
7385
      Flip;
-
 
7386
    end;
-
 
7387
  end;
-
 
7388
  if b1 < b2 then
-
 
7389
  begin
-
 
7390
    for i := b1 to b2 do
-
 
7391
    begin
-
 
7392
      Surface.Fill(RGB(r2, g2, i));
-
 
7393
      Flip;
-
 
7394
    end;
-
 
7395
  end
-
 
7396
  else
-
 
7397
  begin
-
 
7398
    for i := b1 downto b2 do
-
 
7399
    begin
-
 
7400
      Surface.Fill(RGB(r2, g2, i));
-
 
7401
      Flip;
-
 
7402
    end;
-
 
7403
  end;
-
 
7404
  Result := colorto;
-
 
7405
end;
-
 
7406
 
-
 
7407
function TCustomDXDraw.Fade2Black(colorfrom: LongInt): LongInt;
-
 
7408
var i, r, g, b: Integer;
-
 
7409
begin
-
 
7410
  r := GetRValue(colorfrom);
-
 
7411
  g := GetGValue(colorfrom);
-
 
7412
  b := GetBValue(colorfrom);
-
 
7413
  for i := r downto 0 do
-
 
7414
  begin
-
 
7415
    Surface.Fill(RGB(i, g, b));
-
 
7416
    Flip;
-
 
7417
  end;
-
 
7418
  for i := g downto 0 do
-
 
7419
  begin
-
 
7420
    Surface.Fill(RGB(0, i, b));
-
 
7421
    Flip;
-
 
7422
  end;
-
 
7423
  for i := g downto 0 do
-
 
7424
  begin
-
 
7425
    Surface.Fill(RGB(0, 0, i));
-
 
7426
    Flip;
-
 
7427
  end;
-
 
7428
  Result := 0;
-
 
7429
end;
-
 
7430
 
-
 
7431
function TCustomDXDraw.Fade2White(colorfrom: LongInt): LongInt;
-
 
7432
var i, r, g, b: Integer;
-
 
7433
begin
-
 
7434
  r := GetRValue(colorfrom);
-
 
7435
  g := GetGValue(colorfrom);
-
 
7436
  b := GetBValue(colorfrom);
-
 
7437
  for i := r to 255 do
-
 
7438
  begin
-
 
7439
    Surface.Fill(RGB(i, g, b));
-
 
7440
    Flip;
-
 
7441
  end;
-
 
7442
  for i := g to 255 do
-
 
7443
  begin
-
 
7444
    Surface.Fill(RGB(255, i, b));
-
 
7445
    Flip;
-
 
7446
  end;
-
 
7447
  for i := b to 255 do
-
 
7448
  begin
-
 
7449
    Surface.Fill(RGB(255, 255, i));
-
 
7450
    Flip;
-
 
7451
  end;
-
 
7452
  Result := RGB(255, 255, 255);
-
 
7453
end;
-
 
7454
 
-
 
7455
function TCustomDXDraw.Grey2Fade(shadefrom, shadeto: Integer): Integer;
-
 
7456
var i: Integer;
-
 
7457
begin
-
 
7458
  if shadefrom < shadeto then
-
 
7459
  begin
-
 
7460
    for i := shadefrom to shadeto do
-
 
7461
    begin
-
 
7462
      Surface.Fill(RGB(i, i, i));
-
 
7463
      Flip;
-
 
7464
    end;
-
 
7465
  end
-
 
7466
  else
-
 
7467
  begin
-
 
7468
    for i := shadefrom downto shadeto do
-
 
7469
    begin
-
 
7470
      Surface.Fill(RGB(i, i, i));
-
 
7471
      Flip;
-
 
7472
    end;
-
 
7473
  end;
-
 
7474
  Result := shadeto;
-
 
7475
end;
-
 
7476
 
-
 
7477
function TCustomDXDraw.FadeGrey2Screen(oldcolor, newcolour: LongInt): LongInt;
-
 
7478
begin
-
 
7479
  result := Grey2Fade(oldcolor, newcolour);
-
 
7480
end;
-
 
7481
 
-
 
7482
function TCustomDXDraw.Fade2Screen(oldcolor, newcolour: LongInt): LongInt;
-
 
7483
begin
-
 
7484
  result := Fade2Color(oldcolor, newcolour);
-
 
7485
end;
-
 
7486
 
-
 
7487
function TCustomDXDraw.White2Screen(oldcolor: Integer): LongInt;
-
 
7488
begin
-
 
7489
  result := Fade2Color(oldcolor, RGB(255, 255, 255));
-
 
7490
end;
-
 
7491
 
-
 
7492
function TCustomDXDraw.Black2Screen(oldcolor: Integer): LongInt;
-
 
7493
begin
-
 
7494
  result := Fade2Color(oldcolor, RGB(0, 0, 0));
-
 
7495
end;
-
 
7496
 
-
 
7497
procedure TCustomDXDraw.GrabImage(iX, iY, iWidth, iHeight: Integer; ddib: TDIB);
-
 
7498
var ts, td: trect;
-
 
7499
begin
-
 
7500
  ddib.SetSize(iWidth, iHeight, 24);
-
 
7501
  ts.left := iX;
-
 
7502
  ts.top := iY;
-
 
7503
  ts.right := iX + iWidth - 1;
-
 
7504
  ts.bottom := iY + iHeight - 1;
-
 
7505
  td.left := 0;
-
 
7506
  td.top := 0;
-
 
7507
  td.right := iWidth;
-
 
7508
  td.bottom := iHeight;
-
 
7509
  with Surface.Canvas do
-
 
7510
  begin
-
 
7511
    ddib.Canvas.CopyRect(td, Surface.Canvas, ts);
-
 
7512
    Release;
-
 
7513
  end;
-
 
7514
end;
-
 
7515
 
-
 
7516
procedure TCustomDXDraw.PasteImage(sdib: TDIB; x, y: Integer);
-
 
7517
var
-
 
7518
  ts, td: trect;
-
 
7519
  w, h: Integer;
-
 
7520
begin
-
 
7521
  w := sdib.width - 1;
-
 
7522
  h := sdib.height - 1;
-
 
7523
  ts.left := 0;
-
 
7524
  ts.top := 0;
-
 
7525
  ts.right := w;
-
 
7526
  ts.bottom := h;
-
 
7527
  td.left := x;
-
 
7528
  td.top := y;
-
 
7529
  td.right := x + w;
-
 
7530
  td.bottom := y + h;
-
 
7531
  with Surface.Canvas do
-
 
7532
  begin
-
 
7533
    CopyRect(td, sdib.Canvas, ts);
-
 
7534
    release;
-
 
7535
  end;
-
 
7536
end;
-
 
7537
 
-
 
7538
// *****
-
 
7539
 
4528
procedure TCustomDXDraw.SetColorTable(const ColorTable: TRGBQuads);
7540
procedure TCustomDXDraw.SetColorTable(const ColorTable: TRGBQuads);
4529
var
7541
var
4530
  Entries: TPaletteEntries;
7542
  Entries: TPaletteEntries;
4531
begin
7543
begin
4532
  if Initialized and (Palette<>nil) then
7544
  if Initialized and (Palette <> nil) then
4533
  begin
7545
  begin
4534
    Entries := TDXDrawRGBQuadsToPaletteEntries(ColorTable,
7546
    Entries := TDXDrawRGBQuadsToPaletteEntries(ColorTable,
4535
      doAllowPalette256 in FNowOptions);
7547
      doAllowPalette256 in FNowOptions);
4536
    Palette.SetEntries(0, 256, Entries);
7548
    Palette.SetEntries(0, 256, Entries);
4537
  end;
7549
  end;
Line 4541... Line 7553...
4541
var
7553
var
4542
  Flags: Integer;
7554
  Flags: Integer;
4543
  Control: TWinControl;
7555
  Control: TWinControl;
4544
begin
7556
begin
4545
  Control := FForm;
7557
  Control := FForm;
4546
  if Control=nil then
7558
  if Control = nil then
4547
    Control := Self;
7559
    Control := Self;
4548
 
7560
 
4549
  if doFullScreen in FNowOptions then
7561
  if doFullScreen in FNowOptions then
4550
  begin
7562
  begin
4551
    Flags := DDSCL_FULLSCREEN or DDSCL_EXCLUSIVE or DDSCL_ALLOWMODEX;
7563
    Flags := DDSCL_FULLSCREEN or DDSCL_EXCLUSIVE or DDSCL_ALLOWMODEX{$IFDEF DXDOUBLEPRECISION} or DDSCL_FPUPRESERVE{$ENDIF};
4552
    if doNoWindowChange in FNowOptions then
7564
    if doNoWindowChange in FNowOptions then
4553
      Flags := Flags or DDSCL_NOWINDOWCHANGES;
7565
      Flags := Flags or DDSCL_NOWINDOWCHANGES;
4554
    if doAllowReboot in FNowOptions then
7566
    if doAllowReboot in FNowOptions then
4555
      Flags := Flags or DDSCL_ALLOWREBOOT;
7567
      Flags := Flags or DDSCL_ALLOWREBOOT;
4556
  end else
7568
  end else
4557
    Flags := DDSCL_NORMAL;
7569
    Flags := DDSCL_NORMAL{$IFDEF DXDOUBLEPRECISION} or DDSCL_FPUPRESERVE{$ENDIF};
4558
 
7570
 
4559
  DDraw.DXResult := DDraw.IDraw.SetCooperativeLevel(Control.Handle, Flags);
7571
  DDraw.DXResult := DDraw.{$IFDEF D3D_deprecated}IDraw{$ELSE}IDraw7{$ENDIF}.SetCooperativeLevel(Control.Handle, Flags);
4560
end;
7572
end;
4561
 
7573
 
4562
procedure TCustomDXDraw.SetDisplay(Value: TDXDrawDisplay);
7574
procedure TCustomDXDraw.SetDisplay(Value: TDXDrawDisplay);
4563
begin
7575
begin
4564
  FDisplay.Assign(Value);
7576
  FDisplay.Assign(Value);
Line 4574... Line 7586...
4574
    FDriver := Value;
7586
    FDriver := Value;
4575
end;
7587
end;
4576
 
7588
 
4577
procedure TCustomDXDraw.SetOptions(Value: TDXDrawOptions);
7589
procedure TCustomDXDraw.SetOptions(Value: TDXDrawOptions);
4578
const
7590
const
4579
  InitOptions = [doDirectX7Mode, doFullScreen, doNoWindowChange, doAllowReboot,
7591
  InitOptions = [doFullScreen, doNoWindowChange, doAllowReboot,
4580
    doAllowPalette256, doSystemMemory, doFlip, do3D,
7592
    doAllowPalette256, doSystemMemory, doFlip,
-
 
7593
    {$IFDEF D3D_deprecated}doDirectX7Mode, do3D,{$ENDIF}{$IFDEF D3DRM} doRetainedMode, {$ENDIF}
4581
    doRetainedMode, doHardware, doSelectDriver, doZBuffer];
7594
    doHardware, doSelectDriver, doZBuffer];
4582
var
7595
var
4583
  OldOptions: TDXDrawOptions;
7596
  OldOptions: TDXDrawOptions;
4584
begin
7597
begin
4585
  FOptions := Value;
7598
  FOptions := Value;
4586
 
7599
 
4587
  if Initialized then
7600
  if Initialized then
4588
  begin
7601
  begin
4589
    OldOptions := FNowOptions;
7602
    OldOptions := FNowOptions;
4590
    FNowOptions := FNowOptions*InitOptions+(FOptions-InitOptions);
7603
    FNowOptions := FNowOptions * InitOptions + (FOptions - InitOptions);
4591
 
-
 
-
 
7604
    {$IFDEF D3D_deprecated}
4592
    if not (do3D in FNowOptions) then
7605
    if not (do3D in FNowOptions) then
4593
      FNowOptions := FNowOptions - [doHardware, doRetainedMode, doSelectDriver, doZBuffer];
7606
      FNowOptions := FNowOptions - [doHardware, {$IFDEF D3DRM}doRetainedMode,{$ENDIF} doSelectDriver, doZBuffer];
-
 
7607
    {$ENDIF}
4594
  end else
7608
  end else
4595
  begin
7609
  begin
4596
    FNowOptions := FOptions;
7610
    FNowOptions := FOptions;
4597
 
7611
 
4598
    if not (doFullScreen in FNowOptions) then
7612
    if not (doFullScreen in FNowOptions) then
4599
      FNowOptions := FNowOptions - [doNoWindowChange, doAllowReBoot, doAllowPalette256, doFlip];
7613
      FNowOptions := FNowOptions - [doNoWindowChange, doAllowReBoot, doAllowPalette256, doFlip];
4600
 
-
 
-
 
7614
    {$IFDEF D3D_deprecated}
4601
    if not (do3D in FNowOptions) then
7615
    if not (do3D in FNowOptions) then
4602
      FNowOptions := FNowOptions - [doDirectX7Mode, doRetainedMode, doHardware, doSelectDriver, doZBuffer];
7616
      FNowOptions := FNowOptions - [doDirectX7Mode, {$IFDEF D3DRM}doRetainedMode,{$ENDIF} doHardware, doSelectDriver, doZBuffer];
4603
 
7617
    {$ENDIF}
4604
    if doSystemMemory in FNowOptions then
7618
    if doSystemMemory in FNowOptions then
4605
      FNowOptions := FNowOptions - [doFlip];
7619
      FNowOptions := FNowOptions - [doFlip];
4606
 
-
 
-
 
7620
    {$IFDEF D3DRM}
4607
    if doDirectX7Mode in FNowOptions then
7621
    if doDirectX7Mode in FNowOptions then
4608
      FNowOptions := FNowOptions - [doRetainedMode];
7622
      FNowOptions := FNowOptions - [doRetainedMode];
4609
 
7623
    {$ENDIF}
4610
    FNowOptions := FNowOptions - [doHardware];
7624
    FNowOptions := FNowOptions - [doHardware];
4611
  end;
7625
  end;
4612
end;
7626
end;
4613
 
7627
 
4614
procedure TCustomDXDraw.SetParent(AParent: TWinControl);
7628
procedure TCustomDXDraw.SetParent(AParent: TWinControl);
Line 4621... Line 7635...
4621
  FSubClass.Free; FSubClass := nil;
7635
  FSubClass.Free; FSubClass := nil;
4622
 
7636
 
4623
  if not (csDesigning in ComponentState) then
7637
  if not (csDesigning in ComponentState) then
4624
  begin
7638
  begin
4625
    Control := Parent;
7639
    Control := Parent;
4626
    while (Control<>nil) and (not (Control is TCustomForm)) do
7640
    while (Control <> nil) and (not (Control is TCustomForm)) do
4627
      Control := Control.Parent;
7641
      Control := Control.Parent;
4628
    if Control<>nil then
7642
    if Control <> nil then
4629
    begin
7643
    begin
4630
      FForm := TCustomForm(Control);
7644
      FForm := TCustomForm(Control);
4631
      FSubClass := TControlSubClass.Create(Control, FormWndProc);
7645
      FSubClass := TControlSubClass.Create(Control, FormWndProc);
4632
    end;
7646
    end;
4633
  end;
7647
  end;
4634
end;
7648
end;
4635
 
7649
 
4636
procedure TCustomDXDraw.SetSize(ASurfaceWidth, ASurfaceHeight: Integer);
7650
procedure TCustomDXDraw.SetSize(ASurfaceWidth, ASurfaceHeight: Integer);
4637
begin
7651
begin
4638
  if ((ASurfaceWidth<>SurfaceWidth) or (ASurfaceHeight<>SurfaceHeight)) and
7652
  if ((ASurfaceWidth <> SurfaceWidth) or (ASurfaceHeight <> SurfaceHeight)) and
4639
    (not FUpdating) then
7653
    (not FUpdating) then
4640
  begin
7654
  begin
4641
    if Initialized then
7655
    if Initialized then
4642
    begin
7656
    begin
4643
      try
7657
      try
Line 4657... Line 7671...
4657
  end;
7671
  end;
4658
end;
7672
end;
4659
 
7673
 
4660
procedure TCustomDXDraw.SetSurfaceHeight(Value: Integer);
7674
procedure TCustomDXDraw.SetSurfaceHeight(Value: Integer);
4661
begin
7675
begin
4662
  if ComponentState*[csReading, csLoading]=[] then
7676
  if ComponentState * [csReading, csLoading] = [] then
4663
    SetSize(SurfaceWidth, Value)
7677
    SetSize(SurfaceWidth, Value)
4664
  else
7678
  else
4665
    FSurfaceHeight := Value;
7679
    FSurfaceHeight := Value;
4666
end;
7680
end;
4667
 
7681
 
4668
procedure TCustomDXDraw.SetSurfaceWidth(Value: Integer);
7682
procedure TCustomDXDraw.SetSurfaceWidth(Value: Integer);
4669
begin
7683
begin
4670
  if ComponentState*[csReading, csLoading]=[] then
7684
  if ComponentState * [csReading, csLoading] = [] then
4671
    SetSize(Value, SurfaceHeight)
7685
    SetSize(Value, SurfaceHeight)
4672
  else
7686
  else
4673
    FSurfaceWidth := Value;
7687
    FSurfaceWidth := Value;
4674
end;
7688
end;
4675
 
7689
 
4676
function TCustomDXDraw.TryRestore: Boolean;
7690
function TCustomDXDraw.TryRestore: Boolean;
4677
begin
7691
begin
4678
  Result := False;
7692
  Result := False;
4679
 
7693
 
4680
  if Initialized and (not FUpdating) and (Primary.IDDSurface<>nil) then
7694
  if Initialized and (not FUpdating) and (Primary.{$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF} <> nil) then
4681
  begin
7695
  begin
4682
    if (Primary.ISurface.IsLost=DDERR_SURFACELOST) or
7696
    if (Primary.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}.IsLost = DDERR_SURFACELOST) or
4683
      (Surface.ISurface.IsLost=DDERR_SURFACELOST) then
7697
      (Surface.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}.IsLost = DDERR_SURFACELOST) then
4684
    begin
7698
    begin
-
 
7699
      if Assigned(FD2D) and Assigned(FD2D.FD2DTexture) then FD2D.FD2DTexture.D2DPruneAllTextures;//<-Add Mr.Kawasaki
4685
      Restore;
7700
      Restore;
4686
      Result := (Primary.ISurface.IsLost=DD_OK) and (Surface.ISurface.IsLost=DD_OK);
7701
      Result := (Primary.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}.IsLost = DD_OK) and (Surface.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}.IsLost = DD_OK);
4687
    end else
7702
    end else
4688
      Result := True;
7703
      Result := True;
4689
  end;
7704
  end;
4690
end;
7705
end;
4691
 
7706
 
-
 
7707
procedure TCustomDXDraw.SetTraces(const Value: TTraces);
-
 
7708
begin
-
 
7709
  FTraces.Assign(Value);
-
 
7710
end;
-
 
7711
 
4692
procedure TCustomDXDraw.UpdatePalette;
7712
procedure TCustomDXDraw.UpdatePalette;
4693
begin
7713
begin
4694
  if Initialized and (doWaitVBlank in FNowOptions) then
7714
  if Initialized and (doWaitVBlank in FNowOptions) then
4695
  begin
7715
  begin
4696
    if FDDraw.FDriverCaps.dwPalCaps and DDPCAPS_VSYNC=0 then
7716
    if FDDraw.FDriverCaps.dwPalCaps and DDPCAPS_VSYNC = 0 then
4697
      FDDraw.IDraw.WaitForVerticalBlank(DDWAITVB_BLOCKBEGIN, 0);
7717
      FDDraw.{$IFDEF D3D_deprecated}IDraw{$ELSE}IDraw7{$ENDIF}.WaitForVerticalBlank(DDWAITVB_BLOCKBEGIN, 0);
4698
  end;
7718
  end;
4699
 
7719
 
4700
  SetColorTable(ColorTable);
7720
  SetColorTable(ColorTable);
4701
end;
7721
end;
4702
 
7722
 
4703
procedure TCustomDXDraw.WMCreate(var Message: TMessage);
7723
procedure TCustomDXDraw.WMCreate(var Message: TMessage);
4704
begin
7724
begin
4705
  inherited;
7725
  inherited;
4706
  if Initialized and (not FUpdating) then
7726
  if Initialized and (not FUpdating) then
4707
  begin
7727
  begin
4708
    if Clipper<>nil then
7728
    if Clipper <> nil then
4709
      Clipper.Handle := Handle;
7729
      Clipper.Handle := Handle;
4710
    SetCooperativeLevel;
7730
    SetCooperativeLevel;
4711
  end;
7731
  end;
4712
end;
7732
end;
4713
 
7733
 
-
 
7734
{$IFDEF DX3D_deprecated}
-
 
7735
 
4714
{  TCustomDX3D  }
7736
{  TCustomDX3D  }
4715
 
7737
 
4716
constructor TCustomDX3D.Create(AOwner: TComponent);
7738
constructor TCustomDX3D.Create(AOwner: TComponent);
4717
begin
7739
begin
4718
  inherited Create(AOwner);
7740
  inherited Create(AOwner);
Line 4749... Line 7771...
4749
      end;
7771
      end;
4750
    finally
7772
    finally
4751
      FInitialized := False;
7773
      FInitialized := False;
4752
 
7774
 
4753
      SetOptions(FOptions);
7775
      SetOptions(FOptions);
4754
 
-
 
-
 
7776
      {$IFDEF D3DRM}
4755
      FViewport := nil;
7777
      FViewport := nil;
4756
      FCamera := nil;
7778
      FCamera := nil;
4757
      FScene := nil;
7779
      FScene := nil;
4758
 
7780
 
4759
      FD3DRMDevice := nil;
7781
      FD3DRMDevice := nil;
4760
      FD3DRMDevice2 := nil;
7782
      FD3DRMDevice2 := nil;
4761
      FD3DRMDevice3 := nil;
7783
      FD3DRMDevice3 := nil;
-
 
7784
      {$ENDIF}
-
 
7785
      {$IFDEF D3D_deprecated}
4762
      FD3DDevice := nil;
7786
      FD3DDevice := nil;
4763
      FD3DDevice2 := nil;
7787
      FD3DDevice2 := nil;
4764
      FD3DDevice3 := nil;
7788
      FD3DDevice3 := nil;
-
 
7789
      {$ENDIF}
4765
      FD3DDevice7 := nil;
7790
      FD3DDevice7 := nil;
-
 
7791
      {$IFDEF D3D_deprecated}
4766
      FD3D := nil;
7792
      FD3D := nil;
4767
      FD3D2 := nil;
7793
      FD3D2 := nil;
4768
      FD3D3 := nil;
7794
      FD3D3 := nil;
-
 
7795
      {$ENDIF}
4769
      FD3D7 := nil;
7796
      FD3D7 := nil;
4770
 
7797
 
4771
      FreeZBufferSurface(FSurface, FZBuffer);
7798
      FreeZBufferSurface(FSurface, FZBuffer);
4772
 
7799
 
4773
      FSurface.Free;   FSurface := nil;
7800
      FSurface.Free; FSurface := nil;
4774
 
-
 
-
 
7801
      {$IFDEF D3DRM}
4775
      FD3DRM3 := nil;
7802
      FD3DRM3 := nil;
4776
      FD3DRM2 := nil;
7803
      FD3DRM2 := nil;
4777
      FD3DRM := nil;
7804
      FD3DRM := nil;
-
 
7805
      {$ENDIF}
4778
    end;
7806
    end;
4779
  end;
7807
  end;
4780
end;
7808
end;
4781
 
7809
 
4782
procedure TCustomDX3D.Initialize;
7810
procedure TCustomDX3D.Initialize;
Line 4819... Line 7847...
4819
    begin
7847
    begin
4820
      InitializeDirect3D7(FSurface, FZBuffer, FD3D7, FD3DDevice7, AOptions);
7848
      InitializeDirect3D7(FSurface, FZBuffer, FD3D7, FD3DDevice7, AOptions);
4821
    end else
7849
    end else
4822
    begin
7850
    begin
4823
      InitializeDirect3D(FSurface, FZBuffer, FD3D, FD3D2, FD3D3, FD3DDevice, FD3DDevice2, FD3DDevice3,
7851
      InitializeDirect3D(FSurface, FZBuffer, FD3D, FD3D2, FD3D3, FD3DDevice, FD3DDevice2, FD3DDevice3,
4824
        FD3DRM, FD3DRM2, FD3DRM3, FD3DRMDevice, FD3DRMDevice2, FD3DRMDevice3, FViewport, FScene, FCamera, AOptions);
7852
{$IFDEF D3DRM}FD3DRM, FD3DRM2, FD3DRM3, FD3DRMDevice, FD3DRMDevice2, FD3DRMDevice3, FViewport, FScene, FCamera, {$ENDIF}
-
 
7853
        AOptions);
4825
    end;
7854
    end;
4826
 
7855
 
4827
    FNowOptions := [];
7856
    FNowOptions := [];
4828
 
7857
 
4829
    if idoHardware in AOptions then FNowOptions := FNowOptions + [toHardware];
7858
    if idoHardware in AOptions then FNowOptions := FNowOptions + [toHardware];
Line 4838... Line 7867...
4838
  FInitFlag := True; DoInitialize;
7867
  FInitFlag := True; DoInitialize;
4839
end;
7868
end;
4840
 
7869
 
4841
procedure TCustomDX3D.Render;
7870
procedure TCustomDX3D.Render;
4842
begin
7871
begin
-
 
7872
{$IFDEF D3DRM}
4843
  if FInitialized and (toRetainedMode in FNowOptions) then
7873
  if FInitialized and (toRetainedMode in FNowOptions) then
4844
  begin
7874
  begin
4845
    asm FInit end;
7875
    asm FInit end;
4846
    FViewport.Clear;
7876
    FViewport.Clear;
4847
    FViewport.Render(FScene);
7877
    FViewport.Render(FScene);
4848
    FD3DRMDevice.Update;
7878
    FD3DRMDevice.Update;
4849
    asm FInit end;
7879
    asm FInit end;
4850
  end;
7880
  end;
-
 
7881
{$ENDIF}
4851
end;
7882
end;
4852
 
7883
 
4853
function TCustomDX3D.GetCanDraw: Boolean;
7884
function TCustomDX3D.GetCanDraw: Boolean;
4854
begin
7885
begin
4855
  Result := Initialized and (Surface.IDDSurface<>nil) and
7886
  Result := Initialized and (Surface.IDDSurface <> nil) and
4856
    (Surface.ISurface.IsLost=DD_OK);
7887
    (Surface.ISurface.IsLost = DD_OK);
4857
end;
7888
end;
4858
 
7889
 
4859
function TCustomDX3D.GetSurfaceHeight: Integer;
7890
function TCustomDX3D.GetSurfaceHeight: Integer;
4860
begin
7891
begin
4861
  if FSurface.IDDSurface<>nil then
7892
  if FSurface.IDDSurface <> nil then
4862
    Result := FSurface.Height
7893
    Result := FSurface.Height
4863
  else
7894
  else
4864
    Result := FSurfaceHeight;
7895
    Result := FSurfaceHeight;
4865
end;
7896
end;
4866
 
7897
 
4867
function TCustomDX3D.GetSurfaceWidth: Integer;
7898
function TCustomDX3D.GetSurfaceWidth: Integer;
4868
begin
7899
begin
4869
  if FSurface.IDDSurface<>nil then
7900
  if FSurface.IDDSurface <> nil then
4870
    Result := FSurface.Width
7901
    Result := FSurface.Width
4871
  else
7902
  else
4872
    Result := FSurfaceWidth;
7903
    Result := FSurfaceWidth;
4873
end;
7904
end;
4874
 
7905
 
4875
procedure TCustomDX3D.SetAutoSize(Value: Boolean);
7906
procedure TCustomDX3D.SetAutoSize(Value: Boolean);
4876
begin
7907
begin
4877
  if FAutoSize<>Value then
7908
  if FAutoSize <> Value then
4878
  begin
7909
  begin
4879
    FAutoSize := Value;
7910
    FAutoSize := Value;
4880
    if FAutoSize and (DXDraw<>nil) then
7911
    if FAutoSize and (DXDraw <> nil) then
4881
      SetSize(DXDraw.SurfaceWidth, DXDraw.SurfaceHeight);
7912
      SetSize(DXDraw.SurfaceWidth, DXDraw.SurfaceHeight);
4882
  end;
7913
  end;
4883
end;
7914
end;
4884
 
7915
 
4885
procedure TCustomDX3D.SetOptions(Value: TDX3DOptions);
7916
procedure TCustomDX3D.SetOptions(Value: TDX3DOptions);
Line 4892... Line 7923...
4892
  FOptions := Value;
7923
  FOptions := Value;
4893
 
7924
 
4894
  if Initialized then
7925
  if Initialized then
4895
  begin
7926
  begin
4896
    OldOptions := FNowOptions;
7927
    OldOptions := FNowOptions;
4897
    FNowOptions := FNowOptions*InitOptions+FOptions*(DX3DOptions - InitOptions);
7928
    FNowOptions := FNowOptions * InitOptions + FOptions * (DX3DOptions - InitOptions);
4898
  end else
7929
  end else
4899
  begin
7930
  begin
4900
    FNowOptions := FOptions;
7931
    FNowOptions := FOptions;
4901
 
7932
 
4902
    if (FDXDraw<>nil) and (doDirectX7Mode in FDXDraw.FNowOptions) then
7933
    if (FDXDraw <> nil) and (doDirectX7Mode in FDXDraw.FNowOptions) then
4903
      FNowOptions := FNowOptions - [toRetainedMode];
7934
      FNowOptions := FNowOptions - [toRetainedMode];
4904
  end;
7935
  end;
4905
end;
7936
end;
4906
 
7937
 
4907
procedure TCustomDX3D.SetSize(ASurfaceWidth, ASurfaceHeight: Integer);
7938
procedure TCustomDX3D.SetSize(ASurfaceWidth, ASurfaceHeight: Integer);
4908
begin
7939
begin
4909
  if (ASurfaceWidth<>SurfaceWidth) or (ASurfaceHeight<>SurfaceHeight) then
7940
  if (ASurfaceWidth <> SurfaceWidth) or (ASurfaceHeight <> SurfaceHeight) then
4910
  begin
7941
  begin
4911
    FSurfaceWidth := ASurfaceWidth;
7942
    FSurfaceWidth := ASurfaceWidth;
4912
    FSurfaceHeight := ASurfaceHeight;
7943
    FSurfaceHeight := ASurfaceHeight;
4913
 
7944
 
4914
    if Initialized then
7945
    if Initialized then
Line 4916... Line 7947...
4916
  end;
7947
  end;
4917
end;
7948
end;
4918
 
7949
 
4919
procedure TCustomDX3D.SetSurfaceHeight(Value: Integer);
7950
procedure TCustomDX3D.SetSurfaceHeight(Value: Integer);
4920
begin
7951
begin
4921
  if ComponentState*[csReading, csLoading]=[] then
7952
  if ComponentState * [csReading, csLoading] = [] then
4922
    SetSize(SurfaceWidth, Value)
7953
    SetSize(SurfaceWidth, Value)
4923
  else
7954
  else
4924
    FSurfaceHeight := Value;
7955
    FSurfaceHeight := Value;
4925
end;
7956
end;
4926
 
7957
 
4927
procedure TCustomDX3D.SetSurfaceWidth(Value: Integer);
7958
procedure TCustomDX3D.SetSurfaceWidth(Value: Integer);
4928
begin
7959
begin
4929
  if ComponentState*[csReading, csLoading]=[] then
7960
  if ComponentState * [csReading, csLoading] = [] then
4930
    SetSize(Value, SurfaceHeight)
7961
    SetSize(Value, SurfaceHeight)
4931
  else
7962
  else
4932
    FSurfaceWidth := Value;
7963
    FSurfaceWidth := Value;
4933
end;
7964
end;
4934
 
7965
 
4935
procedure TCustomDX3D.Notification(AComponent: TComponent;
7966
procedure TCustomDX3D.Notification(AComponent: TComponent;
4936
  Operation: TOperation);
7967
  Operation: TOperation);
4937
begin
7968
begin
4938
  inherited Notification(AComponent, Operation);
7969
  inherited Notification(AComponent, Operation);
4939
  if (Operation=opRemove) and (FDXDraw=AComponent) then
7970
  if (Operation = opRemove) and (FDXDraw = AComponent) then
4940
    DXDraw := nil;
7971
    DXDraw := nil;
4941
end;
7972
end;
4942
 
7973
 
4943
procedure TCustomDX3D.DXDrawNotifyEvent(Sender: TCustomDXDraw;
7974
procedure TCustomDX3D.DXDrawNotifyEvent(Sender: TCustomDXDraw;
4944
  NotifyType: TDXDrawNotifyType);
7975
  NotifyType: TDXDrawNotifyType);
4945
var
7976
var
4946
  AOptions: TInitializeDirect3DOptions;
7977
  AOptions: TInitializeDirect3DOptions;
4947
begin
7978
begin
4948
  case NotifyType of
7979
  case NotifyType of
4949
    dxntDestroying:
7980
    dxntDestroying:
4950
        begin
7981
      begin
4951
          DXDraw := nil;
7982
        DXDraw := nil;
4952
        end;
7983
      end;
4953
    dxntInitializing:
7984
    dxntInitializing:
-
 
7985
      begin
-
 
7986
        if (FDXDraw.FOptions * [do3D, doFullScreen] = [doFullScreen])
-
 
7987
          and (FOptions * [toSystemMemory, toSelectDriver] = [toSelectDriver]) then
4954
        begin
7988
        begin
4955
          if (FDXDraw.FOptions*[do3D, doFullScreen]=[doFullScreen])
7989
          AOptions := [];
4956
            and (FOptions*[toSystemMemory, toSelectDriver]=[toSelectDriver]) then
7990
          with FDXDraw do
4957
          begin
7991
          begin
4958
            AOptions := [];
-
 
4959
            with FDXDraw do
-
 
4960
            begin
-
 
4961
              if doHardware in Options then AOptions := AOptions + [idoHardware];
7992
            if doHardware in Options then AOptions := AOptions + [idoHardware];
4962
              if doRetainedMode in Options then AOptions := AOptions + [idoRetainedMode];
7993
            if doRetainedMode in Options then AOptions := AOptions + [idoRetainedMode];
4963
              if doSelectDriver in Options then AOptions := AOptions + [idoSelectDriver];
7994
            if doSelectDriver in Options then AOptions := AOptions + [idoSelectDriver];
4964
              if doZBuffer in Options then AOptions := AOptions + [idoZBuffer];
7995
            if doZBuffer in Options then AOptions := AOptions + [idoZBuffer];
4965
            end;
-
 
4966
 
-
 
4967
            Direct3DInitializing_DXDraw(AOptions, FDXDraw);
-
 
4968
          end;
7996
          end;
-
 
7997
 
-
 
7998
          Direct3DInitializing_DXDraw(AOptions, FDXDraw);
4969
        end;
7999
        end;
-
 
8000
      end;
4970
    dxntInitialize:
8001
    dxntInitialize:
4971
        begin
8002
      begin
4972
          Initialize;
8003
        Initialize;
4973
        end;
8004
      end;
4974
    dxntFinalize:
8005
    dxntFinalize:
4975
        begin
8006
      begin
4976
          Finalize;
8007
        Finalize;
4977
        end;
8008
      end;
4978
    dxntRestore:
8009
    dxntRestore:
4979
        begin
8010
      begin
4980
          FSurface.Restore;
8011
        FSurface.Restore;
4981
          if FZBuffer<>nil then
8012
        if FZBuffer <> nil then
4982
            FZBuffer.Restore;
8013
          FZBuffer.Restore;
4983
          FSurface.Palette := FDXDraw.Palette;
8014
        FSurface.Palette := FDXDraw.Palette;
4984
        end;
8015
      end;
4985
    dxntSetSurfaceSize:
8016
    dxntSetSurfaceSize:
4986
        begin
8017
      begin
4987
          if AutoSize then
8018
        if AutoSize then
4988
            SetSize(Sender.SurfaceWidth, Sender.SurfaceHeight);
8019
          SetSize(Sender.SurfaceWidth, Sender.SurfaceHeight);
4989
        end;
8020
      end;
4990
  end;
8021
  end;
4991
end;
8022
end;
4992
 
8023
 
4993
procedure TCustomDX3D.SetDXDraw(Value: TCustomDXDraw);
8024
procedure TCustomDX3D.SetDXDraw(Value: TCustomDXDraw);
4994
begin
8025
begin
4995
  if FDXDraw<>Value then
8026
  if FDXDraw <> Value then
4996
  begin
8027
  begin
4997
    if FDXDraw<>nil then
8028
    if FDXDraw <> nil then
4998
      FDXDraw.UnRegisterNotifyEvent(DXDrawNotifyEvent);
8029
      FDXDraw.UnRegisterNotifyEvent(DXDrawNotifyEvent);
4999
 
8030
 
5000
    FDXDraw := Value;
8031
    FDXDraw := Value;
5001
 
8032
 
5002
    if FDXDraw<>nil then
8033
    if FDXDraw <> nil then
5003
      FDXDraw.RegisterNotifyEvent(DXDrawNotifyEvent);
8034
      FDXDraw.RegisterNotifyEvent(DXDrawNotifyEvent);
5004
  end;
8035
  end;
5005
end;
8036
end;
5006
 
8037
 
-
 
8038
{$ENDIF}
-
 
8039
 
5007
{  TDirect3DTexture  }
8040
{  TDirect3DTexture  }
5008
 
8041
 
5009
constructor TDirect3DTexture.Create(Graphic: TGraphic; DXDraw: TComponent);
8042
constructor TDirect3DTexture.Create(Graphic: TGraphic; DXDraw: TComponent);
5010
var
8043
var
5011
  i: Integer;
8044
  i: Integer;
Line 5015... Line 8048...
5015
  FGraphic := Graphic;
8048
  FGraphic := Graphic;
5016
 
8049
 
5017
  {  The palette is acquired.  }
8050
  {  The palette is acquired.  }
5018
  i := GetPaletteEntries(FGraphic.Palette, 0, 256, FPaletteEntries);
8051
  i := GetPaletteEntries(FGraphic.Palette, 0, 256, FPaletteEntries);
5019
  case i of
8052
  case i of
5020
    1..2   : FBitCount := 1;
8053
    1..2: FBitCount := 1;
5021
    3..16  : FBitCount := 4;
8054
    3..16: FBitCount := 4;
5022
    17..256: FBitCount := 8;
8055
    17..256: FBitCount := 8;
5023
  else
8056
  else
5024
    FBitCount := 24;
8057
    FBitCount := 24;
5025
  end;
8058
  end;
5026
 
8059
 
5027
  if FDXDraw is TCustomDXDraw then
8060
  if FDXDraw is TCustomDXDraw then
5028
  begin
8061
  begin
5029
    with (FDXDraw as TCustomDXDraw) do
8062
    with (FDXDraw as TCustomDXDraw) do
5030
    begin
8063
    begin
5031
      if (not Initialized) or (not (do3D in NowOptions)) then
8064
      if (not Initialized) {$IFDEF D3D_deprecated}or (not (do3D in NowOptions)){$ENDIF} then
5032
        raise EDirect3DTextureError.CreateFmt(SNotMade, [FDXDraw.ClassName]);
8065
        raise EDirect3DTextureError.CreateFmt(SNotMade, [FDXDraw.ClassName]);
5033
    end;
8066
    end;
5034
    FSurface := TDirectDrawSurface.Create((FDXDraw as TCustomDXDraw).Surface.DDraw);
8067
    FSurface := TDirectDrawSurface.Create((FDXDraw as TCustomDXDraw).Surface.DDraw);
5035
    (FDXDraw as TCustomDXDraw).RegisterNotifyEvent(DXDrawNotifyEvent);
8068
    (FDXDraw as TCustomDXDraw).RegisterNotifyEvent(DXDrawNotifyEvent);
5036
  end else if FDXDraw is TCustomDX3D then
8069
  end
5037
  begin
8070
  else
-
 
8071
{$IFDEF DX3D_deprecated}
5038
    with (FDXDraw as TDX3D) do
8072
    if FDXDraw is TCustomDX3D then
5039
    begin
8073
    begin
-
 
8074
      with (FDXDraw as TDX3D) do
-
 
8075
      begin
5040
      if not Initialized then
8076
        if not Initialized then
5041
        raise EDirect3DTextureError.CreateFmt(SNotMade, [FDXDraw.ClassName]);
8077
          raise EDirect3DTextureError.CreateFmt(SNotMade, [FDXDraw.ClassName]);
5042
    end;
8078
      end;
5043
 
8079
 
5044
    FSurface := TDirectDrawSurface.Create((FDXDraw as TCustomDX3D).Surface.DDraw);
8080
      FSurface := TDirectDrawSurface.Create((FDXDraw as TCustomDX3D).Surface.DDraw);
5045
    (FDXDraw as TCustomDX3D).FDXDraw.RegisterNotifyEvent(DXDrawNotifyEvent);
8081
      (FDXDraw as TCustomDX3D).FDXDraw.RegisterNotifyEvent(DXDrawNotifyEvent);
5046
  end else
8082
    end else
-
 
8083
{$ENDIF}
5047
    raise EDirect3DTextureError.CreateFmt(SNotSupported, [FDXDraw.ClassName]);
8084
      raise EDirect3DTextureError.CreateFmt(SNotSupported, [FDXDraw.ClassName]);
5048
end;
8085
end;
5049
 
8086
 
5050
destructor TDirect3DTexture.Destroy;
8087
destructor TDirect3DTexture.Destroy;
5051
begin
8088
begin
5052
  if FDXDraw is TCustomDXDraw then
8089
  if FDXDraw is TCustomDXDraw then
5053
  begin
8090
  begin
5054
    (FDXDraw as TCustomDXDraw).UnRegisterNotifyEvent(DXDrawNotifyEvent);
8091
    (FDXDraw as TCustomDXDraw).UnRegisterNotifyEvent(DXDrawNotifyEvent);
-
 
8092
  end
-
 
8093
{$IFDEF DX3D_deprecated}
5055
  end else if FDXDraw is TCustomDX3D then
8094
  else if FDXDraw is TCustomDX3D then
5056
  begin
8095
  begin
5057
    (FDXDraw as TCustomDX3D).FDXDraw.UnRegisterNotifyEvent(DXDrawNotifyEvent);
8096
    (FDXDraw as TCustomDX3D).FDXDraw.UnRegisterNotifyEvent(DXDrawNotifyEvent);
5058
  end;
8097
  end
5059
 
8098
{$ENDIF};
5060
  Clear;
8099
  Clear;
5061
  FSurface.Free;
8100
  FSurface.Free;
5062
  inherited Destroy;
8101
  inherited Destroy;
5063
end;
8102
end;
5064
 
8103
 
5065
procedure TDirect3DTexture.Clear;
8104
procedure TDirect3DTexture.Clear;
5066
begin
8105
begin
5067
  FHandle := 0;
8106
  FHandle := 0;
5068
  FTexture := nil;
8107
  FTexture := nil;
5069
  FSurface.IDDSurface := nil;
8108
  FSurface.{$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF} := nil;
5070
end;
8109
end;
5071
 
8110
 
5072
function TDirect3DTexture.GetHandle: TD3DTextureHandle;
8111
function TDirect3DTexture.GetHandle: TD3DTextureHandle;
5073
begin
8112
begin
5074
  if FTexture=nil then
8113
  if FTexture = nil then
5075
    Restore;
8114
    Restore;
5076
  Result := FHandle;
8115
  Result := FHandle;
5077
end;
8116
end;
5078
 
8117
 
5079
function TDirect3DTexture.GetSurface: TDirectDrawSurface;
8118
function TDirect3DTexture.GetSurface: TDirectDrawSurface;
5080
begin
8119
begin
5081
  if FTexture=nil then
8120
  if FTexture = nil then
5082
    Restore;
8121
    Restore;
5083
  Result := FSurface;
8122
  Result := FSurface;
5084
end;
8123
end;
5085
 
8124
 
5086
function TDirect3DTexture.GetTexture: IDirect3DTexture;
8125
function TDirect3DTexture.GetTexture: {$IFDEF D3D_deprecated}IDirect3DTexture{$ELSE}IDirect3DTexture2{$ENDIF};
5087
begin
8126
begin
5088
  if FTexture=nil then
8127
  if FTexture = nil then
5089
    Restore;
8128
    Restore;
5090
  Result := FTexture;
8129
  Result := FTexture;
5091
end;
8130
end;
5092
 
8131
 
5093
procedure TDirect3DTexture.SetTransparentColor(Value: TColor);
8132
procedure TDirect3DTexture.SetTransparentColor(Value: TColor);
5094
begin
8133
begin
5095
  if FTransparentColor<>Value then
8134
  if FTransparentColor <> Value then
5096
  begin
8135
  begin
5097
    FTransparentColor := Value;
8136
    FTransparentColor := Value;
5098
 
8137
 
5099
    if FSurface<>nil then
8138
    if FSurface <> nil then
5100
      FSurface.TransparentColor := FSurface.ColorMatch(Value);
8139
      FSurface.TransparentColor := FSurface.ColorMatch(Value);
5101
  end;
8140
  end;
5102
end;
8141
end;
5103
 
8142
 
5104
procedure TDirect3DTexture.Restore;
8143
procedure TDirect3DTexture.Restore;
Line 5116... Line 8155...
5116
 
8155
 
5117
  begin
8156
  begin
5118
    Result := DDENUMRET_OK;
8157
    Result := DDENUMRET_OK;
5119
    tex := lParam;
8158
    tex := lParam;
5120
 
8159
 
5121
    if ddsd.ddpfPixelFormat.dwFlags and (DDPF_ALPHA or DDPF_ALPHAPIXELS)<>0 then
8160
    if ddsd.ddpfPixelFormat.dwFlags and (DDPF_ALPHA or DDPF_ALPHAPIXELS) <> 0 then
5122
      Exit;
8161
      Exit;
5123
 
8162
 
5124
    if not tex.FEnumFormatFlag then
8163
    if not tex.FEnumFormatFlag then
5125
    begin
8164
    begin
5126
      {  When called first,  this format is unconditionally selected.  }
8165
      {  When called first,  this format is unconditionally selected.  }
5127
      UseThisFormat;
8166
      UseThisFormat;
5128
    end else
8167
    end else
5129
    begin
8168
    begin
5130
      if (tex.FBitCount<=8) and (ddsd.ddpfPixelFormat.dwRGBBitCount>=tex.FBitCount) and
8169
      if (tex.FBitCount <= 8) and (ddsd.ddpfPixelFormat.dwRGBBitCount >= tex.FBitCount) and
5131
        (ddsd.ddpfPixelFormat.dwRGBBitCount>=8) and
8170
        (ddsd.ddpfPixelFormat.dwRGBBitCount >= 8) and
5132
        (ddsd.ddpfPixelFormat.dwFlags and DDPF_RGB<>0) then
8171
        (ddsd.ddpfPixelFormat.dwFlags and DDPF_RGB <> 0) then
5133
      begin
8172
      begin
5134
        if tex.FFormat.ddpfPixelFormat.dwRGBBitCount>ddsd.ddpfPixelFormat.dwRGBBitCount then
8173
        if tex.FFormat.ddpfPixelFormat.dwRGBBitCount > ddsd.ddpfPixelFormat.dwRGBBitCount then
5135
          UseThisFormat;
8174
          UseThisFormat;
5136
      end else
8175
      end else
5137
      begin
8176
      begin
5138
        if (tex.FFormat.ddpfPixelFormat.dwRGBBitCount>ddsd.ddpfPixelFormat.dwRGBBitCount) and
8177
        if (tex.FFormat.ddpfPixelFormat.dwRGBBitCount > ddsd.ddpfPixelFormat.dwRGBBitCount) and
5139
          (ddsd.ddpfPixelFormat.dwRGBBitCount>8) and
8178
          (ddsd.ddpfPixelFormat.dwRGBBitCount > 8) and
5140
          (ddsd.ddpfPixelFormat.dwFlags and DDPF_RGB<>0) then
8179
          (ddsd.ddpfPixelFormat.dwFlags and DDPF_RGB <> 0) then
5141
          UseThisFormat;
8180
          UseThisFormat;
5142
      end;
8181
      end;
5143
    end;
8182
    end;
5144
  end;
8183
  end;
5145
 
8184
 
5146
  function GetBitCount(i: Integer): Integer;
8185
  function GetBitCount(i: Integer): Integer;
5147
  var
8186
  var
5148
    j: Integer;
8187
    j: Integer;
5149
  begin
8188
  begin
5150
    for j:=32 downto 1 do
8189
    for j := 32 downto 1 do
5151
      if (1 shl j) and i<>0 then
8190
      if (1 shl j) and i <> 0 then
5152
      begin
8191
      begin
5153
        Result := j;
8192
        Result := j;
5154
        if 1 shl j<>i then
8193
        if 1 shl j <> i then
5155
          Dec(Result);
8194
          Dec(Result);
5156
        Exit;
8195
        Exit;
5157
      end;
8196
      end;
5158
    Result := 0;
8197
    Result := 0;
5159
  end;
8198
  end;
5160
 
8199
 
5161
  function CreateHalftonePalette(R, G, B: Integer): TPaletteEntries;
8200
  function CreateHalftonePalette(R, G, B: Integer): TPaletteEntries;
5162
  var
8201
  var
5163
    i: Integer;
8202
    i: Integer;
5164
  begin
8203
  begin
5165
    for i:=0 to 255 do
8204
    for i := 0 to 255 do
5166
      with Result[i] do
8205
      with Result[i] do
5167
      begin
8206
      begin
5168
        peRed   := ((i shr (G+B-1)) and (1 shl R-1)) * 255 div (1 shl R-1);
8207
        peRed := ((i shr (G + B - 1)) and (1 shl R - 1)) * 255 div (1 shl R - 1);
5169
        peGreen := ((i shr (B-1)) and (1 shl G-1)) * 255 div (1 shl G-1);
8208
        peGreen := ((i shr (B - 1)) and (1 shl G - 1)) * 255 div (1 shl G - 1);
5170
        peBlue  := ((i shr 0) and (1 shl B-1)) * 255 div (1 shl B-1);
8209
        peBlue := ((i shr 0) and (1 shl B - 1)) * 255 div (1 shl B - 1);
5171
        peFlags := 0;
8210
        peFlags := 0;
5172
      end;
8211
      end;
5173
  end;
8212
  end;
5174
 
8213
 
5175
var
8214
var
5176
  ddsd: TDDSurfaceDesc;
8215
  ddsd: {$IFDEF D3D_deprecated}TDDSurfaceDesc{$ELSE}TDDSurfaceDesc2{$ENDIF};
5177
  Palette: TDirectDrawPalette;
8216
  Palette: TDirectDrawPalette;
5178
  PaletteCaps: Integer;
8217
  PaletteCaps: Integer;
5179
  TempSurface: TDirectDrawSurface;
8218
  TempSurface: TDirectDrawSurface;
5180
  Width2, Height2: Integer;
8219
  Width2, Height2: Integer;
5181
  D3DDevice: IDirect3DDevice;
8220
  D3DDevice: {$IFDEF D3D_deprecated}IDirect3DDevice{$ELSE}IDirect3DDevice7{$ENDIF};
5182
  Hardware: Boolean;
8221
  Hardware: Boolean;
5183
  DDraw: TDirectDraw;
8222
  DDraw: TDirectDraw;
5184
begin
8223
begin
5185
  Clear;
8224
  Clear;
5186
  try
8225
  try
5187
    DDraw := nil;
8226
    DDraw := nil;
5188
    Hardware := False;
8227
    Hardware := False;
5189
    if FDXDraw is TCustomDXDraw then
8228
    if FDXDraw is TCustomDXDraw then
5190
    begin
8229
    begin
5191
      DDraw := (FDXDraw as TCustomDXDraw).DDraw;
8230
      DDraw := (FDXDraw as TCustomDXDraw).DDraw;
5192
      D3DDevice := (FDXDraw as TCustomDXDraw).D3DDevice;
8231
      D3DDevice := (FDXDraw as TCustomDXDraw).{$IFDEF D3D_deprecated}D3DDevice{$ELSE}D3DDevice7{$ENDIF};
5193
      Hardware := doHardware in (FDXDraw as TCustomDXDraw).NowOptions;
8232
      Hardware := doHardware in (FDXDraw as TCustomDXDraw).NowOptions;
-
 
8233
    end
-
 
8234
    {$IFDEF DX3D_deprecated}
5194
    end else if FDXDraw is TCustomDX3D then
8235
    else if FDXDraw is TCustomDX3D then
5195
    begin
8236
    begin
5196
      DDraw := (FDXDraw as TCustomDX3D).Surface.DDraw;
8237
      DDraw := (FDXDraw as TCustomDX3D).Surface.DDraw;
5197
      D3DDevice := (FDXDraw as TCustomDX3D).D3DDevice;
8238
      D3DDevice := (FDXDraw as TCustomDX3D).D3DDevice;
5198
      Hardware := toHardware in (FDXDraw as TCustomDX3D).NowOptions;
8239
      Hardware := toHardware in (FDXDraw as TCustomDX3D).NowOptions;
5199
    end;
8240
    end
-
 
8241
    {$ENDIF};
5200
 
8242
 
5201
    if (DDraw=nil) or (D3DDevice=nil) then Exit;
8243
    if (DDraw = nil) or (D3DDevice = nil) then Exit;
5202
 
8244
 
5203
    {  The size of texture is arranged in the size of the square of two.  }
8245
    {  The size of texture is arranged in the size of the square of two.  }
5204
    Width2 := Max(1 shl GetBitCount(FGraphic.Width), 1);
8246
    Width2 := Max(1 shl GetBitCount(FGraphic.Width), 1);
5205
    Height2 := Max(1 shl GetBitCount(FGraphic.Height), 1);
8247
    Height2 := Max(1 shl GetBitCount(FGraphic.Height), 1);
5206
 
8248
 
Line 5241... Line 8283...
5241
 
8283
 
5242
      if not FSurface.CreateSurface(ddsd) then
8284
      if not FSurface.CreateSurface(ddsd) then
5243
        raise EDirect3DTextureError.CreateFmt(SCannotMade, [STexture]);
8285
        raise EDirect3DTextureError.CreateFmt(SCannotMade, [STexture]);
5244
 
8286
 
5245
      {  Make palette.  }
8287
      {  Make palette.  }
5246
      if ddsd.ddpfPixelFormat.dwFlags and DDPF_PALETTEINDEXED8<>0 then
8288
      if ddsd.ddpfPixelFormat.dwFlags and DDPF_PALETTEINDEXED8 <> 0 then
5247
      begin
8289
      begin
5248
        PaletteCaps := DDPCAPS_8BIT or DDPCAPS_ALLOW256;
8290
        PaletteCaps := DDPCAPS_8BIT or DDPCAPS_ALLOW256;
5249
        if FBitCount=24 then
8291
        if FBitCount = 24 then
5250
          CreateHalftonePalette(3, 3, 2);
8292
          CreateHalftonePalette(3, 3, 2);
5251
      end else if ddsd.ddpfPixelFormat.dwFlags and DDPF_PALETTEINDEXED4<>0 then
8293
      end else if ddsd.ddpfPixelFormat.dwFlags and DDPF_PALETTEINDEXED4 <> 0 then
5252
      begin
8294
      begin
5253
        PaletteCaps := DDPCAPS_4BIT;
8295
        PaletteCaps := DDPCAPS_4BIT;
5254
        if FBitCount=24 then
8296
        if FBitCount = 24 then
5255
          CreateHalftonePalette(1, 2, 1);
8297
          CreateHalftonePalette(1, 2, 1);
5256
      end else if ddsd.ddpfPixelFormat.dwFlags and DDPF_PALETTEINDEXED1<>0 then
8298
      end else if ddsd.ddpfPixelFormat.dwFlags and DDPF_PALETTEINDEXED1 <> 0 then
5257
      begin
8299
      begin
5258
        PaletteCaps := DDPCAPS_1BIT;
8300
        PaletteCaps := DDPCAPS_1BIT;
5259
        if FBitCount=24 then
8301
        if FBitCount = 24 then
5260
        begin
8302
        begin
5261
          FPaletteEntries[0] := RGBQuadToPaletteEntry(RGBQuad(0, 0, 0));
8303
          FPaletteEntries[0] := RGBQuadToPaletteEntry(RGBQuad(0, 0, 0));
5262
          FPaletteEntries[1] := RGBQuadToPaletteEntry(RGBQuad(255, 255, 255));
8304
          FPaletteEntries[1] := RGBQuadToPaletteEntry(RGBQuad(255, 255, 255));
5263
        end;
8305
        end;
5264
      end else
8306
      end else
5265
        PaletteCaps := 0;
8307
        PaletteCaps := 0;
5266
 
8308
 
5267
      if PaletteCaps<>0 then
8309
      if PaletteCaps <> 0 then
5268
      begin
8310
      begin
5269
        Palette := TDirectDrawPalette.Create(DDraw);
8311
        Palette := TDirectDrawPalette.Create(DDraw);
5270
        try
8312
        try
5271
          Palette.CreatePalette(PaletteCaps, FPaletteEntries);
8313
          Palette.CreatePalette(PaletteCaps, FPaletteEntries);
5272
          TempSurface.Palette := Palette;
8314
          TempSurface.Palette := Palette;
Line 5282... Line 8324...
5282
        StretchDraw(TempSurface.ClientRect, FGraphic);
8324
        StretchDraw(TempSurface.ClientRect, FGraphic);
5283
        Release;
8325
        Release;
5284
      end;
8326
      end;
5285
 
8327
 
5286
      {  Source surface is loaded into surface.  }
8328
      {  Source surface is loaded into surface.  }
5287
      FTexture := FSurface.ISurface as IDirect3DTexture;
8329
      FTexture := FSurface.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF} as {$IFDEF D3D_deprecated}IDirect3DTexture{$ELSE}IDirect3DTexture2{$ENDIF};
5288
      FTexture.Load(TempSurface.ISurface as IDirect3DTexture);
8330
      FTexture.Load(TempSurface.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF} as {$IFDEF D3D_deprecated}IDirect3DTexture{$ELSE}IDirect3DTexture2{$ENDIF});
5289
    finally
8331
    finally
5290
      TempSurface.Free;
8332
      TempSurface.Free;
5291
    end;
8333
    end;
5292
 
8334
 
5293
    if FTexture.GetHandle(D3DDevice, FHandle)<>D3D_OK then
8335
    if FTexture.GetHandle(D3DDevice as {$IFDEF D3D_deprecated}IDirect3DDevice{$ELSE}IDirect3DDevice2{$ENDIF}, FHandle) <> D3D_OK then
5294
      raise EDirect3DTextureError.CreateFmt(SCannotMade, [STexture]);
8336
      raise EDirect3DTextureError.CreateFmt(SCannotMade, [STexture]);
5295
 
8337
 
5296
    FSurface.TransparentColor := FSurface.ColorMatch(FTransparentColor);
8338
    FSurface.TransparentColor := FSurface.ColorMatch(FTransparentColor);
5297
  except
8339
  except
5298
    Clear;
8340
    Clear;
Line 5303... Line 8345...
5303
procedure TDirect3DTexture.DXDrawNotifyEvent(Sender: TCustomDXDraw;
8345
procedure TDirect3DTexture.DXDrawNotifyEvent(Sender: TCustomDXDraw;
5304
  NotifyType: TDXDrawNotifyType);
8346
  NotifyType: TDXDrawNotifyType);
5305
begin
8347
begin
5306
  case NotifyType of
8348
  case NotifyType of
5307
    dxntInitializeSurface:
8349
    dxntInitializeSurface:
5308
        begin
8350
      begin
5309
          Restore;
8351
        Restore;
5310
        end;
8352
      end;
5311
    dxntRestore:
8353
    dxntRestore:
5312
        begin
8354
      begin
5313
          Restore;
8355
        Restore;
5314
        end;
8356
      end;
5315
  end;
8357
  end;
5316
end;
8358
end;
5317
 
8359
 
5318
{  TDirect3DTexture2  }
8360
{  TDirect3DTexture2  }
5319
 
8361
 
Line 5325... Line 8367...
5325
  FAutoFreeGraphic := AutoFreeGraphic;
8367
  FAutoFreeGraphic := AutoFreeGraphic;
5326
  FNeedLoadTexture := True;
8368
  FNeedLoadTexture := True;
5327
 
8369
 
5328
  if FSrcImage is TDXTextureImage then
8370
  if FSrcImage is TDXTextureImage then
5329
    FImage := TDXTextureImage(FSrcImage)
8371
    FImage := TDXTextureImage(FSrcImage)
-
 
8372
  else
5330
  else if FSrcImage is TDIB then
8373
  if FSrcImage is TDIB then
5331
    SetDIB(TDIB(FSrcImage))
8374
    SetDIB(TDIB(FSrcImage))
-
 
8375
  else
5332
  else if FSrcImage is TGraphic then
8376
  if FSrcImage is TGraphic then
5333
  begin
8377
  begin
5334
    FSrcImage := TDIB.Create;
8378
    FSrcImage := TDIB.Create;
5335
    try
8379
    try
5336
      TDIB(FSrcImage).Assign(TGraphic(Graphic));
8380
      TDIB(FSrcImage).Assign(TGraphic(Graphic));
5337
      SetDIB(TDIB(FSrcImage));
8381
      SetDIB(TDIB(FSrcImage));
5338
    finally
8382
    finally
5339
      if FAutoFreeGraphic then
8383
      if FAutoFreeGraphic then
5340
        Graphic.Free;
8384
        Graphic.Free;
5341
      FAutoFreeGraphic := True;
8385
      FAutoFreeGraphic := True;
5342
    end;
8386
    end;
-
 
8387
  end
5343
  end else
8388
  else
5344
  if FSrcImage is TPicture then
8389
    if FSrcImage is TPicture then
5345
  begin
8390
    begin
5346
    FSrcImage := TDIB.Create;
8391
      FSrcImage := TDIB.Create;
5347
    try
8392
      try
5348
      TDIB(FSrcImage).Assign(TPicture(Graphic).Graphic);
8393
        TDIB(FSrcImage).Assign(TPicture(Graphic).Graphic);
5349
      SetDIB(TDIB(FSrcImage));
8394
        SetDIB(TDIB(FSrcImage));
5350
    finally
8395
      finally
5351
      if FAutoFreeGraphic then
8396
        if FAutoFreeGraphic then
5352
        Graphic.Free;
8397
          Graphic.Free;
5353
      FAutoFreeGraphic := True;
8398
        FAutoFreeGraphic := True;
-
 
8399
      end;
5354
    end;
8400
    end
5355
  end else
8401
    else
5356
    raise Exception.CreateFmt(SCannotLoadGraphic, [Graphic.ClassName]);
8402
      raise Exception.CreateFmt(SCannotLoadGraphic, [Graphic.ClassName]);
5357
 
8403
 
5358
  FMipmap := FImage.SubGroupImageCount[DXTextureImageGroupType_Mipmap]>0;
8404
  FMipmap := FImage.SubGroupImageCount[DXTextureImageGroupType_Mipmap] > 0;
5359
 
8405
 
5360
  FTransparent := FImage.Transparent;
8406
  FTransparent := FImage.Transparent;
5361
  case FImage.ImageType of
8407
  case FImage.ImageType of
5362
    DXTextureImageType_PaletteIndexedColor:
8408
    DXTextureImageType_PaletteIndexedColor:
5363
      begin
8409
      begin
Line 5388... Line 8434...
5388
      Image.Free;
8434
      Image.Free;
5389
      Image := nil;
8435
      Image := nil;
5390
    end;
8436
    end;
5391
 
8437
 
5392
    {  TDIB  }
8438
    {  TDIB  }
5393
    if Image=nil then
8439
    if Image = nil then
5394
    begin
8440
    begin
5395
      Image := TDIB.Create;
8441
      Image := TDIB.Create;
5396
      try
8442
      try
5397
        TDIB(Image).LoadFromFile(FileName);
8443
        TDIB(Image).LoadFromFile(FileName);
5398
      except
8444
      except
Line 5400... Line 8446...
5400
        Image := nil;
8446
        Image := nil;
5401
      end;
8447
      end;
5402
    end;
8448
    end;
5403
 
8449
 
5404
    {  TPicture  }
8450
    {  TPicture  }
5405
    if Image=nil then
8451
    if Image = nil then
5406
    begin
8452
    begin
5407
      Image := TPicture.Create;
8453
      Image := TPicture.Create;
5408
      try
8454
      try
5409
        TPicture(Image).LoadFromFile(FileName);
8455
        TPicture(Image).LoadFromFile(FileName);
5410
      except
8456
      except
Line 5442... Line 8488...
5442
procedure TDirect3DTexture2.DXDrawNotifyEvent(Sender: TCustomDXDraw;
8488
procedure TDirect3DTexture2.DXDrawNotifyEvent(Sender: TCustomDXDraw;
5443
  NotifyType: TDXDrawNotifyType);
8489
  NotifyType: TDXDrawNotifyType);
5444
begin
8490
begin
5445
  case NotifyType of
8491
  case NotifyType of
5446
    dxntDestroying:
8492
    dxntDestroying:
5447
        begin
8493
      begin
5448
          SetDXDraw(nil);
8494
        SetDXDraw(nil);
5449
        end;
8495
      end;
5450
    dxntInitializeSurface:
8496
    dxntInitializeSurface:
5451
        begin
8497
      begin
5452
          Initialize;
8498
        Initialize;
5453
        end;
8499
      end;
5454
    dxntFinalizeSurface:
8500
    dxntFinalizeSurface:
5455
        begin
8501
      begin
5456
          Finalize;
8502
        Finalize;
5457
        end;
8503
      end;
5458
    dxntRestore:
8504
    dxntRestore:
5459
        begin
8505
      begin
5460
          Load;
8506
        Load;
5461
        end;
8507
      end;
5462
  end;
8508
  end;
5463
end;
8509
end;
5464
 
8510
 
5465
procedure TDirect3DTexture2.SetDXDraw(ADXDraw: TCustomDXDraw);
8511
procedure TDirect3DTexture2.SetDXDraw(ADXDraw: TCustomDXDraw);
5466
begin
8512
begin
5467
  if FDXDraw<>ADXDraw then
8513
  if FDXDraw <> ADXDraw then
5468
  begin
8514
  begin
5469
    if FDXDraw<>nil then
8515
    if FDXDraw <> nil then
5470
      FDXDraw.UnRegisterNotifyEvent(DXDrawNotifyEvent);
8516
      FDXDraw.UnRegisterNotifyEvent(DXDrawNotifyEvent);
5471
 
8517
 
5472
    FDXDraw := ADXDraw;
8518
    FDXDraw := ADXDraw;
5473
 
8519
 
5474
    if FDXDraw<>nil then
8520
    if FDXDraw <> nil then
5475
      FDXDraw.RegisterNotifyEvent(DXDrawNotifyEvent);
8521
      FDXDraw.RegisterNotifyEvent(DXDrawNotifyEvent);
5476
  end;
8522
  end;
5477
end;
8523
end;
5478
 
8524
 
5479
procedure TDirect3DTexture2.DoRestoreSurface;
8525
procedure TDirect3DTexture2.DoRestoreSurface;
Line 5484... Line 8530...
5484
 
8530
 
5485
procedure TDirect3DTexture2.SetDIB(DIB: TDIB);
8531
procedure TDirect3DTexture2.SetDIB(DIB: TDIB);
5486
var
8532
var
5487
  i: Integer;
8533
  i: Integer;
5488
begin
8534
begin
5489
  if FImage2=nil then
8535
  if FImage2 = nil then
5490
    FImage2 := TDXTextureImage.Create;
8536
    FImage2 := TDXTextureImage.Create;
5491
 
8537
 
5492
  if DIB.BitCount<=8 then
8538
  if DIB.BitCount <= 8 then
5493
  begin
8539
  begin
5494
    FImage2.SetImage(DXTextureImageType_PaletteIndexedColor, DIB.Width, DIB.Height, DIB.BitCount,
8540
    FImage2.SetImage(DXTextureImageType_PaletteIndexedColor, DIB.Width, DIB.Height, DIB.BitCount,
5495
      DIB.WidthBytes, DIB.NextLine, DIB.PBits, DIB.TopPBits, DIB.Size, False);
8541
      DIB.WidthBytes, DIB.NextLine, DIB.PBits, DIB.TopPBits, DIB.Size, False);
5496
 
8542
 
5497
    FImage2.idx_index := dxtMakeChannel((1 shl DIB.BitCount)-1, True);
8543
    FImage2.idx_index := dxtMakeChannel((1 shl DIB.BitCount) - 1, True);
5498
    for i:=0 to 255 do
8544
    for i := 0 to 255 do
5499
      FImage2.idx_palette[i] := RGBQuadToPaletteEntry(DIB.ColorTable[i]);
8545
      FImage2.idx_palette[i] := RGBQuadToPaletteEntry(DIB.ColorTable[i]);
5500
  end else
8546
  end else
5501
  begin
8547
  begin
5502
    FImage2.SetImage(DXTextureImageType_RGBColor, DIB.Width, DIB.Height, DIB.BitCount,
8548
    FImage2.SetImage(DXTextureImageType_RGBColor, DIB.Width, DIB.Height, DIB.BitCount,
5503
      DIB.WidthBytes, DIB.NextLine, DIB.PBits, DIB.TopPBits, DIB.Size, False);
8549
      DIB.WidthBytes, DIB.NextLine, DIB.PBits, DIB.TopPBits, DIB.Size, False);
5504
 
8550
 
5505
    FImage2.rgb_red := dxtMakeChannel(DIB.NowPixelFormat.RBitMask, False);
8551
    FImage2.rgb_red := dxtMakeChannel(DIB.NowPixelFormat.RBitMask, False);
5506
    FImage2.rgb_green := dxtMakeChannel(DIB.NowPixelFormat.GBitMask, False);
8552
    FImage2.rgb_green := dxtMakeChannel(DIB.NowPixelFormat.GBitMask, False);
5507
    FImage2.rgb_blue := dxtMakeChannel(DIB.NowPixelFormat.BBitMask, False);
8553
    FImage2.rgb_blue := dxtMakeChannel(DIB.NowPixelFormat.BBitMask, False);
5508
 
8554
 
5509
    i := DIB.NowPixelFormat.RBitCount+DIB.NowPixelFormat.GBitCount+DIB.NowPixelFormat.BBitCount;
8555
    i := DIB.NowPixelFormat.RBitCount + DIB.NowPixelFormat.GBitCount + DIB.NowPixelFormat.BBitCount;
5510
    if i<DIB.BitCount then
8556
    if i < DIB.BitCount then
5511
      FImage2.rgb_alpha := dxtMakeChannel(((1 shl (DIB.BitCount-i))-1) shl i, False);
8557
      FImage2.rgb_alpha := dxtMakeChannel(((1 shl (DIB.BitCount - i)) - 1) shl i, False);
5512
  end;
8558
  end;
5513
 
8559
 
5514
  FImage := FImage2;
8560
  FImage := FImage2;
5515
end;
8561
end;
5516
 
8562
 
-
 
8563
function TDirect3DTexture2.GetHeight: Integer;
-
 
8564
begin
-
 
8565
  if Assigned(FImage) then
-
 
8566
    Result := FImage.Height
-
 
8567
  else
-
 
8568
    if Assigned(FImage2) then
-
 
8569
      Result := FImage2.Height
-
 
8570
    else
-
 
8571
      Result := 0;
-
 
8572
end;
-
 
8573
 
5517
function TDirect3DTexture2.GetIsMipmap: Boolean;
8574
function TDirect3DTexture2.GetIsMipmap: Boolean;
5518
begin
8575
begin
5519
  if FSurface<>nil then
8576
  if FSurface <> nil then
5520
    Result := FUseMipmap
8577
    Result := FUseMipmap
5521
  else
8578
  else
5522
    Result := FMipmap;
8579
    Result := FMipmap;
5523
end;
8580
end;
5524
 
8581
 
5525
function TDirect3DTexture2.GetSurface: TDirectDrawSurface;
8582
function TDirect3DTexture2.GetSurface: TDirectDrawSurface;
5526
begin
8583
begin
5527
  Result := FSurface;
8584
  Result := FSurface;
5528
  if (Result<>nil) and FNeedLoadTexture then
8585
  if (Result <> nil) and FNeedLoadTexture then
5529
    Load;
8586
    Load;
5530
end;
8587
end;
5531
 
8588
 
5532
function TDirect3DTexture2.GetTransparent: Boolean;
8589
function TDirect3DTexture2.GetTransparent: Boolean;
5533
begin
8590
begin
5534
  if FSurface<>nil then
8591
  if FSurface <> nil then
5535
    Result := FUseColorKey
8592
    Result := FUseColorKey
5536
  else
8593
  else
5537
    Result := FTransparent;
8594
    Result := FTransparent;
5538
end;
8595
end;
5539
 
8596
 
-
 
8597
function TDirect3DTexture2.GetWidth: Integer;
-
 
8598
begin
-
 
8599
  if Assigned(FImage) then
-
 
8600
    Result := FImage.Width
-
 
8601
  else
-
 
8602
    if Assigned(FImage2) then
-
 
8603
      Result := FImage2.Width
-
 
8604
    else
-
 
8605
      Result := 0;
-
 
8606
end;
-
 
8607
 
5540
procedure TDirect3DTexture2.SetTransparent(Value: Boolean);
8608
procedure TDirect3DTexture2.SetTransparent(Value: Boolean);
5541
begin
8609
begin
5542
  if FTransparent<>Value then
8610
  if FTransparent <> Value then
5543
  begin
8611
  begin
5544
    FTransparent := Value;
8612
    FTransparent := Value;
5545
    if FSurface<>nil then
8613
    if FSurface <> nil then
5546
      SetColorKey;
8614
      SetColorKey;
5547
  end;
8615
  end;
5548
end;
8616
end;
5549
 
8617
 
5550
procedure TDirect3DTexture2.SetTransparentColor(Value: TColorRef);
8618
procedure TDirect3DTexture2.SetTransparentColor(Value: TColorRef);
5551
begin
8619
begin
5552
  if FTransparentColor<>Value then
8620
  if FTransparentColor <> Value then
5553
  begin
8621
  begin
5554
    FTransparentColor := Value;
8622
    FTransparentColor := Value;
5555
    if (FSurface<>nil) and FTransparent then
8623
    if (FSurface <> nil) and FTransparent then
5556
      SetColorKey;
8624
      SetColorKey;
5557
  end;
8625
  end;
5558
end;
8626
end;
5559
 
8627
 
5560
procedure TDirect3DTexture2.Finalize;
8628
procedure TDirect3DTexture2.Finalize;
Line 5573... Line 8641...
5573
procedure TDirect3DTexture2.Initialize;
8641
procedure TDirect3DTexture2.Initialize;
5574
 
8642
 
5575
  function GetBitCount(i: Integer): Integer;
8643
  function GetBitCount(i: Integer): Integer;
5576
  begin
8644
  begin
5577
    Result := 31;
8645
    Result := 31;
5578
    while (i>=0) and (((1 shl Result) and i)=0) do Dec(Result);
8646
    while (i >= 0) and (((1 shl Result) and i) = 0) do Dec(Result);
5579
  end;
8647
  end;
5580
 
8648
 
5581
  function GetMaskBitCount(b: Integer): Integer;
8649
  function GetMaskBitCount(b: Integer): Integer;
5582
  var
8650
  var
5583
    i: Integer;
8651
    i: Integer;
5584
  begin
8652
  begin
5585
    i := 0;
8653
    i := 0;
5586
    while (i<31) and (((1 shl i) and b)=0) do Inc(i);
8654
    while (i < 31) and (((1 shl i) and b) = 0) do Inc(i);
5587
 
8655
 
5588
    Result := 0;
8656
    Result := 0;
5589
    while ((1 shl i) and b)<>0 do
8657
    while ((1 shl i) and b) <> 0 do
5590
    begin
8658
    begin
5591
      Inc(i);
8659
      Inc(i);
5592
      Inc(Result);
8660
      Inc(Result);
5593
    end;
8661
    end;
5594
  end;
8662
  end;
5595
 
8663
 
5596
  function GetPaletteBitCount(const ddpfPixelFormat: TDDPixelFormat): Integer;
8664
  function GetPaletteBitCount(const ddpfPixelFormat: TDDPixelFormat): Integer;
5597
  begin
8665
  begin
5598
    if ddpfPixelFormat.dwFlags and DDPF_PALETTEINDEXED8<>0 then
8666
    if ddpfPixelFormat.dwFlags and DDPF_PALETTEINDEXED8 <> 0 then
5599
      Result := 8
8667
      Result := 8
5600
    else if ddpfPixelFormat.dwFlags and DDPF_PALETTEINDEXED4<>0 then
8668
    else if ddpfPixelFormat.dwFlags and DDPF_PALETTEINDEXED4 <> 0 then
5601
      Result := 4
8669
      Result := 4
5602
    else if ddpfPixelFormat.dwFlags and DDPF_PALETTEINDEXED2<>0 then
8670
    else if ddpfPixelFormat.dwFlags and DDPF_PALETTEINDEXED2 <> 0 then
5603
      Result := 2
8671
      Result := 2
5604
    else if ddpfPixelFormat.dwFlags and DDPF_PALETTEINDEXED1<>0 then
8672
    else if ddpfPixelFormat.dwFlags and DDPF_PALETTEINDEXED1 <> 0 then
5605
      Result := 1
8673
      Result := 1
5606
    else
8674
    else
5607
      Result := 0;
8675
      Result := 0;
5608
  end;
8676
  end;
5609
 
8677
 
Line 5652... Line 8720...
5652
          idx_index := tex.FImage.idx_index.bitcount;
8720
          idx_index := tex.FImage.idx_index.bitcount;
5653
        end;
8721
        end;
5654
    end;
8722
    end;
5655
 
8723
 
5656
    {  The texture examines whether this pixel format can be used.  }
8724
    {  The texture examines whether this pixel format can be used.  }
5657
    if lpDDPixFmt.dwFlags and DDPF_RGB=0 then Exit;
8725
    if lpDDPixFmt.dwFlags and DDPF_RGB = 0 then Exit;
5658
 
8726
 
5659
    case tex.FImage.ImageType of
8727
    case tex.FImage.ImageType of
5660
      DXTextureImageType_RGBColor:
8728
      DXTextureImageType_RGBColor:
5661
        begin
8729
        begin
5662
          if lpDDPixFmt.dwFlags and DDPF_PALETTEINDEXED<>0 then Exit;
8730
          if lpDDPixFmt.dwFlags and DDPF_PALETTEINDEXED <> 0 then Exit;
5663
        end;
8731
        end;
5664
      DXTextureImageType_PaletteIndexedColor:
8732
      DXTextureImageType_PaletteIndexedColor:
5665
        begin
8733
        begin
5666
          if (lpDDPixFmt.dwFlags and DDPF_PALETTEINDEXED<>0) and
8734
          if (lpDDPixFmt.dwFlags and DDPF_PALETTEINDEXED <> 0) and
5667
            (GetPaletteBitCount(lpDDPixFmt)<idx_index) then Exit;
8735
            (GetPaletteBitCount(lpDDPixFmt) < idx_index) then Exit;
5668
        end;
8736
        end;
5669
    end;
8737
    end;
5670
 
8738
 
5671
    {  The pixel format which can be used is selected carefully.  }
8739
    {  The pixel format which can be used is selected carefully.  }
5672
    if tex.FEnumTextureFormatFlag then
8740
    if tex.FEnumTextureFormatFlag then
5673
    begin
8741
    begin
5674
      if lpDDPixFmt.dwFlags and DDPF_PALETTEINDEXED<>0 then
8742
      if lpDDPixFmt.dwFlags and DDPF_PALETTEINDEXED <> 0 then
5675
      begin
8743
      begin
5676
        {  Bit count check  }
8744
        {  Bit count check  }
5677
        if Abs(Integer(lpDDPixFmt.dwRGBBitCount)-idx_index)>
8745
        if Abs(Integer(lpDDPixFmt.dwRGBBitCount) - idx_index) >
5678
          Abs(Integer(tex.FTextureFormat.ddpfPixelFormat.dwRGBBitCount)-idx_index) then Exit;
8746
          Abs(Integer(tex.FTextureFormat.ddpfPixelFormat.dwRGBBitCount) - idx_index) then Exit;
5679
 
8747
 
5680
        {  Alpha channel check  }
8748
        {  Alpha channel check  }
5681
        if rgb_alpha>0 then Exit;
8749
        if rgb_alpha > 0 then Exit;
5682
      end else
8750
      end else
5683
      if lpDDPixFmt.dwFlags and DDPF_RGB<>0 then
8751
        if lpDDPixFmt.dwFlags and DDPF_RGB <> 0 then
5684
      begin
-
 
5685
        {  The alpha channel is indispensable.  }
-
 
5686
        if (rgb_alpha>0) and (tex.FTextureFormat.ddpfPixelFormat.dwFlags and DDPF_ALPHAPIXELS=0) and
-
 
5687
          (lpDDPixFmt.dwFlags and DDPF_ALPHAPIXELS<>0) then
-
 
5688
        begin
8752
        begin
-
 
8753
        {  The alpha channel is indispensable.  }
-
 
8754
          if (rgb_alpha > 0) and (tex.FTextureFormat.ddpfPixelFormat.dwFlags and DDPF_ALPHAPIXELS = 0) and
-
 
8755
            (lpDDPixFmt.dwFlags and DDPF_ALPHAPIXELS <> 0) then
-
 
8756
          begin
5689
          UseThisFormat;
8757
            UseThisFormat;
5690
          Exit;
8758
            Exit;
5691
        end;
8759
          end;
5692
 
8760
 
5693
        {  Alpha channel check  }
8761
        {  Alpha channel check  }
5694
        if (rgb_alpha>0) and (tex.FTextureFormat.ddpfPixelFormat.dwFlags and DDPF_ALPHAPIXELS<>0) and
8762
          if (rgb_alpha > 0) and (tex.FTextureFormat.ddpfPixelFormat.dwFlags and DDPF_ALPHAPIXELS <> 0) and
5695
          (lpDDPixFmt.dwFlags and DDPF_ALPHAPIXELS=0) then
8763
            (lpDDPixFmt.dwFlags and DDPF_ALPHAPIXELS = 0) then
5696
        begin
8764
          begin
5697
          Exit;
8765
            Exit;
5698
        end;
8766
          end;
5699
 
8767
 
5700
        {  Bit count check  }
8768
        {  Bit count check  }
5701
        if tex.FTextureFormat.ddpfPixelFormat.dwFlags and DDPF_PALETTEINDEXED=0 then
8769
          if tex.FTextureFormat.ddpfPixelFormat.dwFlags and DDPF_PALETTEINDEXED = 0 then
5702
        begin
8770
          begin
5703
          sum1 := Sqr(GetMaskBitCount(lpDDPixFmt.dwRBitMask)-rgb_red)+
8771
            sum1 := Sqr(GetMaskBitCount(lpDDPixFmt.dwRBitMask) - rgb_red) +
5704
            Sqr(GetMaskBitCount(lpDDPixFmt.dwGBitMask)-rgb_green)+
8772
              Sqr(GetMaskBitCount(lpDDPixFmt.dwGBitMask) - rgb_green) +
5705
            Sqr(GetMaskBitCount(lpDDPixFmt.dwBBitMask)-rgb_blue)+
8773
              Sqr(GetMaskBitCount(lpDDPixFmt.dwBBitMask) - rgb_blue) +
5706
            Sqr(GetMaskBitCount(lpDDPixFmt.dwRGBAlphaBitMask)-rgb_alpha);
8774
              Sqr(GetMaskBitCount(lpDDPixFmt.dwRGBAlphaBitMask) - rgb_alpha);
5707
 
8775
 
5708
          sum2 := Sqr(GetMaskBitCount(tex.FTextureFormat.ddpfPixelFormat.dwRBitMask)-rgb_red)+
8776
            sum2 := Sqr(GetMaskBitCount(tex.FTextureFormat.ddpfPixelFormat.dwRBitMask) - rgb_red) +
5709
            Sqr(GetMaskBitCount(tex.FTextureFormat.ddpfPixelFormat.dwGBitMask)-rgb_green)+
8777
              Sqr(GetMaskBitCount(tex.FTextureFormat.ddpfPixelFormat.dwGBitMask) - rgb_green) +
5710
            Sqr(GetMaskBitCount(tex.FTextureFormat.ddpfPixelFormat.dwBBitMask)-rgb_blue)+
8778
              Sqr(GetMaskBitCount(tex.FTextureFormat.ddpfPixelFormat.dwBBitMask) - rgb_blue) +
5711
            Sqr(GetMaskBitCount(tex.FTextureFormat.ddpfPixelFormat.dwRGBAlphaBitMask)-rgb_alpha);
8779
              Sqr(GetMaskBitCount(tex.FTextureFormat.ddpfPixelFormat.dwRGBAlphaBitMask) - rgb_alpha);
5712
 
8780
 
5713
          if sum1>sum2 then Exit;
8781
            if sum1 > sum2 then Exit;
-
 
8782
          end;
5714
        end;
8783
        end;
5715
      end;
-
 
5716
    end;
8784
    end;
5717
 
8785
 
5718
    UseThisFormat;
8786
    UseThisFormat;
5719
  end;
8787
  end;
5720
 
8788
 
5721
var
8789
var
5722
  Width, Height: Integer;
8790
  Width, Height: Integer;
5723
  PaletteCaps: DWORD;
8791
  PaletteCaps: DWORD;
5724
  Palette: IDirectDrawPalette;
8792
  Palette: IDirectDrawPalette;
5725
  TempD3DDevDesc: TD3DDeviceDesc;
8793
  {$IFDEF D3D_deprecated}TempD3DDevDesc: TD3DDeviceDesc;{$ENDIF}
5726
  D3DDevDesc7: TD3DDeviceDesc7;
8794
  D3DDevDesc7: TD3DDeviceDesc7;
5727
  TempSurface: IDirectDrawSurface4;
8795
  TempSurface: {$IFDEF D3D_deprecated}IDirectDrawSurface4{$ELSE}IDirectDrawSurface7{$ENDIF};
5728
begin
8796
begin
5729
  Finalize;
8797
  Finalize;
5730
  try
8798
  try
5731
    if FDXDraw.D3DDevice7<>nil then
8799
    if FDXDraw.D3DDevice7 <> nil then
5732
    begin
8800
    begin
5733
      FDXDraw.D3DDevice7.GetCaps(D3DDevDesc7);
8801
      FDXDraw.D3DDevice7.GetCaps(D3DDevDesc7);
5734
      FD3DDevDesc.dpcLineCaps.dwTextureCaps := D3DDevDesc7.dpcLineCaps.dwTextureCaps;
8802
      FD3DDevDesc.dpcLineCaps.dwTextureCaps := D3DDevDesc7.dpcLineCaps.dwTextureCaps;
5735
      FD3DDevDesc.dpcTriCaps.dwTextureCaps := D3DDevDesc7.dpcTriCaps.dwTextureCaps;
8803
      FD3DDevDesc.dpcTriCaps.dwTextureCaps := D3DDevDesc7.dpcTriCaps.dwTextureCaps;
5736
      FD3DDevDesc.dwMinTextureWidth := D3DDevDesc7.dwMinTextureWidth;
8804
      FD3DDevDesc.dwMinTextureWidth := D3DDevDesc7.dwMinTextureWidth;
5737
      FD3DDevDesc.dwMaxTextureWidth := D3DDevDesc7.dwMaxTextureWidth;
8805
      FD3DDevDesc.dwMaxTextureWidth := D3DDevDesc7.dwMaxTextureWidth;
-
 
8806
    end
-
 
8807
    {$IFDEF D3D_deprecated}
5738
    end else
8808
    else
5739
    begin
8809
    begin
5740
      FD3DDevDesc.dwSize := SizeOf(FD3DDevDesc);
8810
      FD3DDevDesc.dwSize := SizeOf(FD3DDevDesc);
5741
      TempD3DDevDesc.dwSize := SizeOf(TempD3DDevDesc);
8811
      TempD3DDevDesc.dwSize := SizeOf(TempD3DDevDesc);
5742
      FDXDraw.D3DDevice3.GetCaps(FD3DDevDesc, TempD3DDevDesc);
8812
      FDXDraw.D3DDevice3.GetCaps(FD3DDevDesc, TempD3DDevDesc);
5743
    end;
8813
    end{$ENDIF};
5744
 
8814
 
5745
    if FImage<>nil then
8815
    if FImage <> nil then
5746
    begin
8816
    begin
5747
      {  Size adjustment of texture  }
8817
      {  Size adjustment of texture  }
5748
      if FD3DDevDesc.dpcTriCaps.dwTextureCaps and D3DPTEXTURECAPS_POW2<>0 then
8818
      if FD3DDevDesc.dpcTriCaps.dwTextureCaps and D3DPTEXTURECAPS_POW2 <> 0 then
5749
      begin
8819
      begin
5750
        {  The size of the texture is only Sqr(n).  }
8820
        {  The size of the texture is only Sqr(n).  }
5751
        Width := Max(1 shl GetBitCount(FImage.Width), 1);
8821
        Width := Max(1 shl GetBitCount(FImage.Width), 1);
5752
        Height := Max(1 shl GetBitCount(FImage.Height), 1);
8822
        Height := Max(1 shl GetBitCount(FImage.Height), 1);
-
 
8823
      end
5753
      end else
8824
      else
5754
      begin
8825
      begin
5755
        Width := FImage.Width;
8826
        Width := FImage.Width;
5756
        Height := FImage.Height;
8827
        Height := FImage.Height;
5757
      end;
8828
      end;
5758
 
8829
 
5759
      if FD3DDevDesc.dpcTriCaps.dwTextureCaps and D3DPTEXTURECAPS_SQUAREONLY<>0 then
8830
      if FD3DDevDesc.dpcTriCaps.dwTextureCaps and D3DPTEXTURECAPS_SQUAREONLY <> 0 then
5760
      begin
8831
      begin
5761
        {  The size of the texture is only a square.  }
8832
        {  The size of the texture is only a square.  }
5762
        if Width<Height then Width := Height;
8833
        if Width < Height then Width := Height;
5763
        Height := Width;
8834
        Height := Width;
5764
      end;
8835
      end;
5765
 
8836
 
5766
      if FD3DDevDesc.dwMinTextureWidth>0 then
8837
      if FD3DDevDesc.dwMinTextureWidth > 0 then
5767
        Width := Max(Width, FD3DDevDesc.dwMinTextureWidth);
8838
        Width := Max(Width, FD3DDevDesc.dwMinTextureWidth);
5768
 
8839
 
5769
      if FD3DDevDesc.dwMaxTextureWidth>0 then
8840
      if FD3DDevDesc.dwMaxTextureWidth > 0 then
5770
        Width := Min(Width, FD3DDevDesc.dwMaxTextureWidth);
8841
        Width := Min(Width, FD3DDevDesc.dwMaxTextureWidth);
5771
 
8842
 
5772
      if FD3DDevDesc.dwMinTextureHeight>0 then
8843
      if FD3DDevDesc.dwMinTextureHeight > 0 then
5773
        Height := Max(Height, FD3DDevDesc.dwMinTextureHeight);
8844
        Height := Max(Height, FD3DDevDesc.dwMinTextureHeight);
5774
 
8845
 
5775
      if FD3DDevDesc.dwMaxTextureHeight>0 then
8846
      if FD3DDevDesc.dwMaxTextureHeight > 0 then
5776
        Height := Min(Height, FD3DDevDesc.dwMaxTextureHeight);
8847
        Height := Min(Height, FD3DDevDesc.dwMaxTextureHeight);
5777
 
8848
 
5778
      {  Pixel format selection  }
8849
      {  Pixel format selection  }
5779
      FEnumTextureFormatFlag := False;
8850
      FEnumTextureFormatFlag := False;
5780
      if FDXDraw.D3DDevice7<>nil then
8851
      if FDXDraw.D3DDevice7 <> nil then
5781
        FDXDraw.D3DDevice7.EnumTextureFormats(@EnumTextureFormatCallback, Self)
8852
        FDXDraw.D3DDevice7.EnumTextureFormats(@EnumTextureFormatCallback, Self)
5782
      else
8853
      {$IFDEF D3D_deprecated}else
5783
        FDXDraw.D3DDevice3.EnumTextureFormats(@EnumTextureFormatCallback, Self);
8854
        FDXDraw.D3DDevice3.EnumTextureFormats(@EnumTextureFormatCallback, Self){$ENDIF};
5784
 
8855
 
5785
      if not FEnumTextureFormatFlag then
8856
      if not FEnumTextureFormatFlag then
5786
        raise EDirect3DTextureError.CreateFmt(SCannotInitialized, [STexture]);
8857
        raise EDirect3DTextureError.CreateFmt(SCannotInitialized, [STexture]);
5787
 
8858
 
5788
      {  Is Mipmap surface used ?  }
8859
      {  Is Mipmap surface used ?  }
5789
      FUseMipmap := FMipmap and (FTextureFormat.ddpfPixelFormat.dwRGBBitCount>8) and
8860
      FUseMipmap := FMipmap and (FTextureFormat.ddpfPixelFormat.dwRGBBitCount > 8) and
5790
        (FImage.SubGroupImageCount[DXTextureImageGroupType_Mipmap]>0) and (FDXDraw.DDraw.DriverCaps.ddsCaps.dwCaps and DDSCAPS_MIPMAP<>0);
8861
        (FImage.SubGroupImageCount[DXTextureImageGroupType_Mipmap] > 0) and (FDXDraw.DDraw.DriverCaps.ddsCaps.dwCaps and DDSCAPS_MIPMAP <> 0);
5791
 
8862
 
5792
      {  Surface form setting  }
8863
      {  Surface form setting  }
5793
      with FTextureFormat do
8864
      with FTextureFormat do
5794
      begin
8865
      begin
5795
        dwSize := SizeOf(FTextureFormat);
8866
        dwSize := SizeOf(FTextureFormat);
Line 5812... Line 8883...
5812
        end;
8883
        end;
5813
      end;
8884
      end;
5814
    end;
8885
    end;
5815
 
8886
 
5816
    FSurface := TDirectDrawSurface.Create(FDXDraw.DDraw);
8887
    FSurface := TDirectDrawSurface.Create(FDXDraw.DDraw);
5817
    FSurface.DDraw.DXResult := FSurface.DDraw.IDraw4.CreateSurface(FTextureFormat, TempSurface, nil);
8888
    FSurface.DDraw.DXResult := FSurface.DDraw.{$IFDEF D3D_deprecated}IDraw4{$ELSE}IDraw7{$ENDIF}.CreateSurface(FTextureFormat, TempSurface, nil);
5818
    if FSurface.DDraw.DXResult<>DD_OK then
8889
    if FSurface.DDraw.DXResult <> DD_OK then
5819
      raise EDirect3DTextureError.CreateFmt(SCannotInitialized, [STexture]);
8890
      raise EDirect3DTextureError.CreateFmt(SCannotInitialized, [STexture]);
5820
    FSurface.IDDSurface4 := TempSurface;
8891
    FSurface.{$IFDEF D3D_deprecated}IDDSurface4{$ELSE}IDDSurface7{$ENDIF} := TempSurface;
5821
 
8892
 
5822
    {  Palette making  }
8893
    {  Palette making  }
5823
    if (FImage<>nil) and (FTextureFormat.ddpfPixelFormat.dwFlags and DDPF_PALETTEINDEXED<>0) then
8894
    if (FImage <> nil) and (FTextureFormat.ddpfPixelFormat.dwFlags and DDPF_PALETTEINDEXED <> 0) then
5824
    begin
8895
    begin
5825
      if FTextureFormat.ddpfPixelFormat.dwFlags and DDPF_PALETTEINDEXED8<>0 then
8896
      if FTextureFormat.ddpfPixelFormat.dwFlags and DDPF_PALETTEINDEXED8 <> 0 then
5826
        PaletteCaps := DDPCAPS_8BIT or DDPCAPS_ALLOW256
8897
        PaletteCaps := DDPCAPS_8BIT or DDPCAPS_ALLOW256
-
 
8898
      else
5827
      else if FTextureFormat.ddpfPixelFormat.dwFlags and DDPF_PALETTEINDEXED4<>0 then
8899
      if FTextureFormat.ddpfPixelFormat.dwFlags and DDPF_PALETTEINDEXED4 <> 0 then
5828
        PaletteCaps := DDPCAPS_4BIT
8900
        PaletteCaps := DDPCAPS_4BIT
-
 
8901
      else
5829
      else if FTextureFormat.ddpfPixelFormat.dwFlags and DDPF_PALETTEINDEXED2<>0 then
8902
      if FTextureFormat.ddpfPixelFormat.dwFlags and DDPF_PALETTEINDEXED2 <> 0 then
5830
        PaletteCaps := DDPCAPS_2BIT
8903
        PaletteCaps := DDPCAPS_2BIT
-
 
8904
      else
5831
      else if FTextureFormat.ddpfPixelFormat.dwFlags and DDPF_PALETTEINDEXED1<>0 then
8905
      if FTextureFormat.ddpfPixelFormat.dwFlags and DDPF_PALETTEINDEXED1 <> 0 then
5832
        PaletteCaps := DDPCAPS_1BIT
8906
        PaletteCaps := DDPCAPS_1BIT
5833
      else
8907
      else
5834
        PaletteCaps := 0;
8908
        PaletteCaps := 0;
5835
 
8909
 
5836
      if PaletteCaps<>0 then
8910
      if PaletteCaps <> 0 then
5837
      begin
8911
      begin
5838
        if FDXDraw.DDraw.IDraw.CreatePalette(PaletteCaps, @FImage.idx_palette, Palette, nil)<>0 then
8912
        if FDXDraw.DDraw.{$IFDEF D3D_deprecated}IDraw{$ELSE}IDraw7{$ENDIF}.CreatePalette(PaletteCaps, @FImage.idx_palette, Palette, nil) <> 0 then
5839
          Exit;
8913
          Exit;
5840
 
8914
 
5841
        FSurface.ISurface.SetPalette(Palette);
8915
        FSurface.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}.SetPalette(Palette);
5842
      end;
8916
      end;
5843
    end;
8917
    end;
5844
 
8918
 
5845
    FNeedLoadTexture := True;
8919
    FNeedLoadTexture := True;
5846
  except
8920
  except
Line 5851... Line 8925...
5851
 
8925
 
5852
procedure TDirect3DTexture2.Load;
8926
procedure TDirect3DTexture2.Load;
5853
const
8927
const
5854
  MipmapCaps: TDDSCaps2 = (dwCaps: DDSCAPS_TEXTURE or DDSCAPS_MIPMAP);
8928
  MipmapCaps: TDDSCaps2 = (dwCaps: DDSCAPS_TEXTURE or DDSCAPS_MIPMAP);
5855
var
8929
var
5856
  CurSurface, NextSurface: IDirectDrawSurface4;
8930
  CurSurface, NextSurface: {$IFDEF D3D_deprecated}IDirectDrawSurface4{$ELSE}IDirectDrawSurface7{$ENDIF};
5857
  Index: Integer;
8931
  Index: Integer;
5858
  SrcImage: TDXTextureImage;
8932
  SrcImage: TDXTextureImage;
5859
begin
8933
begin
5860
  if FSurface=nil then
8934
  if FSurface = nil then
5861
    Initialize;
8935
    Initialize;
5862
 
8936
 
5863
  FNeedLoadTexture := False;
8937
  FNeedLoadTexture := False;
5864
  if FSurface.ISurface.IsLost=DDERR_SURFACELOST then
8938
  if FSurface.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}.IsLost = DDERR_SURFACELOST then
5865
    FSurface.Restore;
8939
    FSurface.Restore;
5866
 
8940
 
5867
  {  Color key setting.  }
8941
  {  Color key setting.  }
5868
  SetColorKey;
8942
  SetColorKey;
5869
 
8943
 
5870
  {  Image loading into surface.  }
8944
  {  Image loading into surface.  }
5871
  if FImage<>nil then
8945
  if FImage <> nil then
5872
  begin
8946
  begin
5873
    if FSrcImage is TDIB then
8947
    if FSrcImage is TDIB then
5874
      SetDIB(TDIB(FSrcImage));
8948
      SetDIB(TDIB(FSrcImage));
5875
 
8949
 
5876
    CurSurface := FSurface.ISurface4;
8950
    CurSurface := FSurface.{$IFDEF D3D_deprecated}ISurface4{$ELSE}ISurface7{$ENDIF};
5877
    Index := 0;
8951
    Index := 0;
5878
    while CurSurface<>nil do
8952
    while CurSurface <> nil do
5879
    begin
8953
    begin
5880
      SrcImage := FImage;
8954
      SrcImage := FImage;
5881
      if Index>0 then
8955
      if Index > 0 then
5882
      begin
8956
      begin
5883
        if Index-1>=FImage.SubGroupImageCount[DXTextureImageGroupType_Mipmap] then
8957
        if Index - 1 >= FImage.SubGroupImageCount[DXTextureImageGroupType_Mipmap] then
5884
          Break;
8958
          Break;
5885
        SrcImage := FImage.SubGroupImages[DXTextureImageGroupType_Mipmap, Index-1];
8959
        SrcImage := FImage.SubGroupImages[DXTextureImageGroupType_Mipmap, Index - 1];
5886
      end;
8960
      end;
5887
 
8961
 
5888
      LoadSubTexture(CurSurface, SrcImage);
8962
      LoadSubTexture(CurSurface, SrcImage);
5889
 
8963
 
5890
      if CurSurface.GetAttachedSurface(MipmapCaps, NextSurface)=0 then
8964
      if CurSurface.GetAttachedSurface(MipmapCaps, NextSurface) = 0 then
5891
        CurSurface := NextSurface
8965
        CurSurface := NextSurface
5892
      else
8966
      else
5893
        CurSurface := nil;
8967
        CurSurface := nil;
5894
 
8968
 
5895
      Inc(Index);
8969
      Inc(Index);
5896
    end;
8970
    end;
-
 
8971
  end
5897
  end else
8972
  else
5898
    DoRestoreSurface;
8973
    DoRestoreSurface;
5899
end;
8974
end;
5900
 
8975
 
5901
procedure TDirect3DTexture2.SetColorKey;
8976
procedure TDirect3DTexture2.SetColorKey;
5902
var
8977
var
5903
  ck: TDDColorKey;
8978
  ck: TDDColorKey;
5904
begin
8979
begin
5905
  FUseColorKey := False;
8980
  FUseColorKey := False;
5906
 
8981
 
5907
  if (FSurface<>nil) and FTransparent and (FD3DDevDesc.dpcTriCaps.dwTextureCaps and D3DPTEXTURECAPS_TRANSPARENCY<>0) then
8982
  if (FSurface <> nil) and FTransparent and (FD3DDevDesc.dpcTriCaps.dwTextureCaps and D3DPTEXTURECAPS_TRANSPARENCY <> 0) then
5908
  begin
8983
  begin
5909
    FillChar(ck, SizeOf(ck), 0);
8984
    FillChar(ck, SizeOf(ck), 0);
5910
    if FSurface.SurfaceDesc.ddpfPixelFormat.dwFlags and DDPF_PALETTEINDEXED<>0 then
8985
    if FSurface.SurfaceDesc.ddpfPixelFormat.dwFlags and DDPF_PALETTEINDEXED <> 0 then
5911
    begin
8986
    begin
5912
      if FTransparentColor shr 24=$01 then
8987
      if FTransparentColor shr 24 = $01 then
5913
      begin
8988
      begin
5914
        {  Palette index  }
8989
        {  Palette index  }
5915
        ck.dwColorSpaceLowValue := FTransparentColor and $FF;
8990
        ck.dwColorSpaceLowValue := FTransparentColor and $FF;
-
 
8991
      end
5916
      end else
8992
      else
5917
      if FImage<>nil then
8993
        if FImage <> nil then
5918
      begin
8994
        begin
5919
        {  RGB value  }
8995
        {  RGB value  }
5920
        ck.dwColorSpaceLowValue := FImage.PaletteIndex(GetRValue(FTransparentColor), GetGValue(FTransparentColor), GetBValue(FTransparentColor));
8996
          ck.dwColorSpaceLowValue := FImage.PaletteIndex(GetRValue(FTransparentColor), GetGValue(FTransparentColor), GetBValue(FTransparentColor));
5921
      end else
8997
        end else
5922
        Exit;
8998
          Exit;
-
 
8999
    end
5923
    end else
9000
    else
5924
    begin
9001
    begin
5925
      if (FImage<>nil) and (FImage.ImageType=DXTextureImageType_PaletteIndexedColor) and (FTransparentColor shr 24=$01) then
9002
      if (FImage <> nil) and (FImage.ImageType = DXTextureImageType_PaletteIndexedColor) and (FTransparentColor shr 24 = $01) then
5926
      begin
9003
      begin
5927
        {  Palette index  }
9004
        {  Palette index  }
5928
        ck.dwColorSpaceLowValue :=
9005
        ck.dwColorSpaceLowValue :=
5929
          dxtEncodeChannel(dxtMakeChannel(FSurface.SurfaceDesc.ddpfPixelFormat.dwRBitMask, False), FImage.idx_palette[FTransparentColor and $FF].peRed) or
9006
          dxtEncodeChannel(dxtMakeChannel(FSurface.SurfaceDesc.ddpfPixelFormat.dwRBitMask, False), FImage.idx_palette[FTransparentColor and $FF].peRed) or
5930
          dxtEncodeChannel(dxtMakeChannel(FSurface.SurfaceDesc.ddpfPixelFormat.dwGBitMask, False), FImage.idx_palette[FTransparentColor and $FF].peGreen) or
9007
          dxtEncodeChannel(dxtMakeChannel(FSurface.SurfaceDesc.ddpfPixelFormat.dwGBitMask, False), FImage.idx_palette[FTransparentColor and $FF].peGreen) or
5931
          dxtEncodeChannel(dxtMakeChannel(FSurface.SurfaceDesc.ddpfPixelFormat.dwBBitMask, False), FImage.idx_palette[FTransparentColor and $FF].peBlue);
9008
          dxtEncodeChannel(dxtMakeChannel(FSurface.SurfaceDesc.ddpfPixelFormat.dwBBitMask, False), FImage.idx_palette[FTransparentColor and $FF].peBlue);
-
 
9009
      end
5932
      end else
9010
      else
5933
      if FTransparentColor shr 24=$00 then
9011
        if FTransparentColor shr 24 = $00 then
5934
      begin
9012
        begin
5935
        {  RGB value  }
9013
        {  RGB value  }
5936
        ck.dwColorSpaceLowValue :=
9014
          ck.dwColorSpaceLowValue :=
5937
          dxtEncodeChannel(dxtMakeChannel(FSurface.SurfaceDesc.ddpfPixelFormat.dwRBitMask, False), GetRValue(FTransparentColor)) or
9015
            dxtEncodeChannel(dxtMakeChannel(FSurface.SurfaceDesc.ddpfPixelFormat.dwRBitMask, False), GetRValue(FTransparentColor)) or
5938
          dxtEncodeChannel(dxtMakeChannel(FSurface.SurfaceDesc.ddpfPixelFormat.dwGBitMask, False), GetGValue(FTransparentColor)) or
9016
            dxtEncodeChannel(dxtMakeChannel(FSurface.SurfaceDesc.ddpfPixelFormat.dwGBitMask, False), GetGValue(FTransparentColor)) or
5939
          dxtEncodeChannel(dxtMakeChannel(FSurface.SurfaceDesc.ddpfPixelFormat.dwBBitMask, False), GetBValue(FTransparentColor));
9017
            dxtEncodeChannel(dxtMakeChannel(FSurface.SurfaceDesc.ddpfPixelFormat.dwBBitMask, False), GetBValue(FTransparentColor));
-
 
9018
        end
5940
      end else
9019
        else
5941
        Exit;
9020
          Exit;
5942
    end;
9021
    end;
5943
 
9022
 
5944
    ck.dwColorSpaceHighValue := ck.dwColorSpaceLowValue;
9023
    ck.dwColorSpaceHighValue := ck.dwColorSpaceLowValue;
5945
    FSurface.ISurface.SetColorKey(DDCKEY_SRCBLT, ck);
9024
    FSurface.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}.SetColorKey(DDCKEY_SRCBLT, @ck);
5946
 
9025
 
5947
    FUseColorKey := True;
9026
    FUseColorKey := True;
5948
  end;
9027
  end;
5949
end;
9028
end;
5950
 
9029
 
5951
procedure TDirect3DTexture2.LoadSubTexture(Dest: IDirectDrawSurface4; SrcImage: TDXTextureImage);
9030
procedure TDirect3DTexture2.LoadSubTexture(Dest: {$IFDEF D3D_deprecated}IDirectDrawSurface4{$ELSE}IDirectDrawSurface7{$ENDIF}; SrcImage: TDXTextureImage);
5952
const
9031
const
5953
  Mask1: array[0..7] of DWORD = (1, 2, 4, 8, 16, 32, 64, 128);
9032
  Mask1: array[0..7] of DWORD = (1, 2, 4, 8, 16, 32, 64, 128);
5954
  Mask2: array[0..3] of DWORD = (3, 12, 48, 192);
9033
  Mask2: array[0..3] of DWORD = (3, 12, 48, 192);
5955
  Mask4: array[0..1] of DWORD = ($0F, $F0);
9034
  Mask4: array[0..1] of DWORD = ($0F, $F0);
5956
  Shift1: array[0..7] of DWORD = (0, 1, 2, 3, 4, 5, 6, 7);
9035
  Shift1: array[0..7] of DWORD = (0, 1, 2, 3, 4, 5, 6, 7);
Line 5958... Line 9037...
5958
  Shift4: array[0..1] of DWORD = (0, 4);
9037
  Shift4: array[0..1] of DWORD = (0, 4);
5959
 
9038
 
5960
  procedure SetPixel(const ddsd: TDDSurfaceDesc2; x, y: Integer; c: DWORD);
9039
  procedure SetPixel(const ddsd: TDDSurfaceDesc2; x, y: Integer; c: DWORD);
5961
  begin
9040
  begin
5962
    case ddsd.ddpfPixelFormat.dwRGBBitCount of
9041
    case ddsd.ddpfPixelFormat.dwRGBBitCount of
5963
      1 : PByte(Integer(ddsd.lpSurface)+ddsd.lPitch*y+x div 8)^ :=
9042
      1: PByte(Integer(ddsd.lpSurface) + ddsd.lPitch * y + x div 8)^ :=
5964
            (PByte(Integer(ddsd.lpSurface)+ddsd.lPitch*y+x div 8)^ and (not Mask1[x mod 8])) or (c shl Shift1[x mod 8]);
9043
        (PByte(Integer(ddsd.lpSurface) + ddsd.lPitch * y + x div 8)^ and (not Mask1[x mod 8])) or (c shl Shift1[x mod 8]);
5965
      2 : PByte(Integer(ddsd.lpSurface)+ddsd.lPitch*y+x div 4)^ :=
9044
      2: PByte(Integer(ddsd.lpSurface) + ddsd.lPitch * y + x div 4)^ :=
5966
            (PByte(Integer(ddsd.lpSurface)+ddsd.lPitch*y+x div 4)^ and (not Mask2[x mod 4])) or (c shl Shift2[x mod 4]);
9045
        (PByte(Integer(ddsd.lpSurface) + ddsd.lPitch * y + x div 4)^ and (not Mask2[x mod 4])) or (c shl Shift2[x mod 4]);
5967
      4 : PByte(Integer(ddsd.lpSurface)+ddsd.lPitch*y+x div 2)^ :=
9046
      4: PByte(Integer(ddsd.lpSurface) + ddsd.lPitch * y + x div 2)^ :=
5968
            (PByte(Integer(ddsd.lpSurface)+ddsd.lPitch*y+x div 2)^ and (not Mask4[x mod 2])) or (c shl Shift4[x mod 2]);
9047
        (PByte(Integer(ddsd.lpSurface) + ddsd.lPitch * y + x div 2)^ and (not Mask4[x mod 2])) or (c shl Shift4[x mod 2]);
5969
      8 : PByte(Integer(ddsd.lpSurface)+ddsd.lPitch*y+x)^ := c;
9048
      8: PByte(Integer(ddsd.lpSurface) + ddsd.lPitch * y + x)^ := c;
5970
      16: PWord(Integer(ddsd.lpSurface)+ddsd.lPitch*y+x*2)^ := c;
9049
      16: PWord(Integer(ddsd.lpSurface) + ddsd.lPitch * y + x * 2)^ := c;
5971
      24: begin
9050
      24: begin
5972
            PByte(Integer(ddsd.lpSurface)+ddsd.lPitch*y+x*3)^ := c shr 0;
9051
          PByte(Integer(ddsd.lpSurface) + ddsd.lPitch * y + x * 3)^ := c shr 0;
5973
            PByte(Integer(ddsd.lpSurface)+ddsd.lPitch*y+x*3+1)^ := c shr 8;
9052
          PByte(Integer(ddsd.lpSurface) + ddsd.lPitch * y + x * 3 + 1)^ := c shr 8;
5974
            PByte(Integer(ddsd.lpSurface)+ddsd.lPitch*y+x*3+2)^ := c shr 16;
9053
          PByte(Integer(ddsd.lpSurface) + ddsd.lPitch * y + x * 3 + 2)^ := c shr 16;
5975
          end;  
9054
        end;
5976
      32: PDWORD(Integer(ddsd.lpSurface)+ddsd.lPitch*y+x*4)^ := c;
9055
      32: PDWORD(Integer(ddsd.lpSurface) + ddsd.lPitch * y + x * 4)^ := c;
5977
    end;
9056
    end;
5978
  end;
9057
  end;
5979
 
9058
 
5980
  procedure LoadTexture_IndexToIndex;
9059
  procedure LoadTexture_IndexToIndex;
5981
  var
9060
  var
5982
    ddsd: TDDSurfaceDesc2;
9061
    ddsd: TDDSurfaceDesc2;
5983
    x, y: Integer;
9062
    x, y: Integer;
5984
  begin
9063
  begin
5985
    ddsd.dwSize := SizeOf(ddsd);
9064
    ddsd.dwSize := SizeOf(ddsd);
5986
    if Dest.Lock(nil, ddsd, DDLOCK_WAIT, 0)=0 then
9065
    if Dest.Lock(nil, ddsd, DDLOCK_WAIT, 0) = 0 then
5987
    begin
9066
    begin
5988
      try
9067
      try
5989
        if (SrcImage.idx_index.Mask=DWORD(1 shl ddsd.ddpfPixelFormat.dwRGBBitCount)-1) and (SrcImage.idx_alpha.Mask=0) and
9068
        if (SrcImage.idx_index.Mask = DWORD(1 shl ddsd.ddpfPixelFormat.dwRGBBitCount) - 1) and
-
 
9069
          (SrcImage.idx_alpha.Mask = 0) and
5990
          (SrcImage.BitCount=Integer(ddsd.ddpfPixelFormat.dwRGBBitCount)) and (not SrcImage.PackedPixelOrder) then
9070
          (SrcImage.BitCount = Integer(ddsd.ddpfPixelFormat.dwRGBBitCount)) and
-
 
9071
          (not SrcImage.PackedPixelOrder)
-
 
9072
        then
5991
        begin
9073
        begin
5992
          for y:=0 to ddsd.dwHeight-1 do
9074
          for y := 0 to ddsd.dwHeight - 1 do
5993
            Move(SrcImage.ScanLine[y]^, Pointer(Integer(ddsd.lpSurface)+ddsd.lPitch*y)^, (Integer(ddsd.dwWidth)*SrcImage.BitCount+7) div 8);
9075
            Move(SrcImage.ScanLine[y]^, Pointer(Integer(ddsd.lpSurface) + ddsd.lPitch * y)^, (Integer(ddsd.dwWidth) * SrcImage.BitCount + 7) div 8);
-
 
9076
        end
5994
        end else
9077
        else
5995
        begin
9078
        begin
5996
          for y:=0 to ddsd.dwHeight-1 do
9079
          for y := 0 to ddsd.dwHeight - 1 do
5997
          begin
9080
          begin
5998
            for x:=0 to ddsd.dwWidth-1 do
9081
            for x := 0 to ddsd.dwWidth - 1 do
5999
              SetPixel(ddsd, x, y, dxtDecodeChannel(SrcImage.idx_index, SrcImage.Pixels[x, y]));
9082
              SetPixel(ddsd, x, y, dxtDecodeChannel(SrcImage.idx_index, SrcImage.Pixels[x, y]));
6000
          end;
9083
          end;
6001
        end;
9084
        end;
6002
      finally
9085
      finally
6003
        Dest.UnLock(ddsd.lpSurface);
9086
        Dest.UnLock(ddsd.lpSurface);
Line 6011... Line 9094...
6011
    x, y: Integer;
9094
    x, y: Integer;
6012
    c, cIdx, cA: DWORD;
9095
    c, cIdx, cA: DWORD;
6013
    dest_red_fmt, dest_green_fmt, dest_blue_fmt, dest_alpha_fmt: TDXTextureImageChannel;
9096
    dest_red_fmt, dest_green_fmt, dest_blue_fmt, dest_alpha_fmt: TDXTextureImageChannel;
6014
  begin
9097
  begin
6015
    ddsd.dwSize := SizeOf(ddsd);
9098
    ddsd.dwSize := SizeOf(ddsd);
6016
    if Dest.Lock(nil, ddsd, DDLOCK_WAIT, 0)=0 then
9099
    if Dest.Lock(nil, ddsd, DDLOCK_WAIT, 0) = 0 then
6017
    begin
9100
    begin
6018
      try
9101
      try
6019
        dest_red_fmt := dxtMakeChannel(ddsd.ddpfPixelFormat.dwRBitMask, False);
9102
        dest_red_fmt := dxtMakeChannel(ddsd.ddpfPixelFormat.dwRBitMask, False);
6020
        dest_green_fmt := dxtMakeChannel(ddsd.ddpfPixelFormat.dwGBitMask, False);
9103
        dest_green_fmt := dxtMakeChannel(ddsd.ddpfPixelFormat.dwGBitMask, False);
6021
        dest_blue_fmt := dxtMakeChannel(ddsd.ddpfPixelFormat.dwBBitMask, False);
9104
        dest_blue_fmt := dxtMakeChannel(ddsd.ddpfPixelFormat.dwBBitMask, False);
6022
        dest_alpha_fmt := dxtMakeChannel(ddsd.ddpfPixelFormat.dwRGBAlphaBitMask, False);
9105
        dest_alpha_fmt := dxtMakeChannel(ddsd.ddpfPixelFormat.dwRGBAlphaBitMask, False);
6023
 
9106
 
6024
        if SrcImage.idx_alpha.mask<>0 then
9107
        if SrcImage.idx_alpha.mask <> 0 then
6025
        begin
9108
        begin
6026
          for y:=0 to ddsd.dwHeight-1 do
9109
          for y := 0 to ddsd.dwHeight - 1 do
6027
            for x:=0 to ddsd.dwWidth-1 do
9110
            for x := 0 to ddsd.dwWidth - 1 do
6028
            begin
9111
            begin
6029
              c := SrcImage.Pixels[x, y];
9112
              c := SrcImage.Pixels[x, y];
6030
              cIdx := dxtDecodeChannel(SrcImage.idx_index, c);
9113
              cIdx := dxtDecodeChannel(SrcImage.idx_index, c);
6031
 
9114
 
6032
              c := dxtEncodeChannel(dest_red_fmt, SrcImage.idx_palette[cIdx].peRed) or
9115
              c := dxtEncodeChannel(dest_red_fmt, SrcImage.idx_palette[cIdx].peRed) or
Line 6034... Line 9117...
6034
                dxtEncodeChannel(dest_blue_fmt, SrcImage.idx_palette[cIdx].peBlue) or
9117
                dxtEncodeChannel(dest_blue_fmt, SrcImage.idx_palette[cIdx].peBlue) or
6035
                dxtEncodeChannel(dest_alpha_fmt, dxtDecodeChannel(SrcImage.idx_alpha, c));
9118
                dxtEncodeChannel(dest_alpha_fmt, dxtDecodeChannel(SrcImage.idx_alpha, c));
6036
 
9119
 
6037
              SetPixel(ddsd, x, y, c);
9120
              SetPixel(ddsd, x, y, c);
6038
            end;
9121
            end;
-
 
9122
        end
6039
        end else
9123
        else
6040
        begin
9124
        begin
6041
          cA := dxtEncodeChannel(dest_alpha_fmt, 255);
9125
          cA := dxtEncodeChannel(dest_alpha_fmt, 255);
6042
 
9126
 
6043
          for y:=0 to ddsd.dwHeight-1 do
9127
          for y := 0 to ddsd.dwHeight - 1 do
6044
            for x:=0 to ddsd.dwWidth-1 do
9128
            for x := 0 to ddsd.dwWidth - 1 do
6045
            begin
9129
            begin
6046
              c := SrcImage.Pixels[x, y];
9130
              c := SrcImage.Pixels[x, y];
6047
              cIdx := dxtDecodeChannel(SrcImage.idx_index, c);
9131
              cIdx := dxtDecodeChannel(SrcImage.idx_index, c);
6048
 
9132
 
6049
              c := dxtEncodeChannel(dest_red_fmt, SrcImage.idx_palette[cIdx].peRed) or
9133
              c := dxtEncodeChannel(dest_red_fmt, SrcImage.idx_palette[cIdx].peRed) or
Line 6065... Line 9149...
6065
    x, y: Integer;
9149
    x, y: Integer;
6066
    c, cA: DWORD;
9150
    c, cA: DWORD;
6067
    dest_red_fmt, dest_green_fmt, dest_blue_fmt, dest_alpha_fmt: TDXTextureImageChannel;
9151
    dest_red_fmt, dest_green_fmt, dest_blue_fmt, dest_alpha_fmt: TDXTextureImageChannel;
6068
  begin
9152
  begin
6069
    ddsd.dwSize := SizeOf(ddsd);
9153
    ddsd.dwSize := SizeOf(ddsd);
6070
    if Dest.Lock(nil, ddsd, DDLOCK_WAIT, 0)=0 then
9154
    if Dest.Lock(nil, ddsd, DDLOCK_WAIT, 0) = 0 then
6071
    begin
9155
    begin
6072
      try
9156
      try
6073
        dest_red_fmt := dxtMakeChannel(ddsd.ddpfPixelFormat.dwRBitMask, False);
9157
        dest_red_fmt := dxtMakeChannel(ddsd.ddpfPixelFormat.dwRBitMask, False);
6074
        dest_green_fmt := dxtMakeChannel(ddsd.ddpfPixelFormat.dwGBitMask, False);
9158
        dest_green_fmt := dxtMakeChannel(ddsd.ddpfPixelFormat.dwGBitMask, False);
6075
        dest_blue_fmt := dxtMakeChannel(ddsd.ddpfPixelFormat.dwBBitMask, False);
9159
        dest_blue_fmt := dxtMakeChannel(ddsd.ddpfPixelFormat.dwBBitMask, False);
6076
        dest_alpha_fmt := dxtMakeChannel(ddsd.ddpfPixelFormat.dwRGBAlphaBitMask, False);
9160
        dest_alpha_fmt := dxtMakeChannel(ddsd.ddpfPixelFormat.dwRGBAlphaBitMask, False);
6077
 
9161
 
6078
        if (dest_red_fmt.Mask=SrcImage.rgb_red.Mask) and (dest_green_fmt.Mask=SrcImage.rgb_green.Mask) and
9162
        if (dest_red_fmt.Mask = SrcImage.rgb_red.Mask) and (dest_green_fmt.Mask = SrcImage.rgb_green.Mask) and
6079
          (dest_blue_fmt.Mask=SrcImage.rgb_blue.Mask) and (dest_alpha_fmt.Mask=SrcImage.rgb_alpha.Mask) and
9163
          (dest_blue_fmt.Mask = SrcImage.rgb_blue.Mask) and (dest_alpha_fmt.Mask = SrcImage.rgb_alpha.Mask) and
6080
          (Integer(ddsd.ddpfPixelFormat.dwRGBBitCount)=SrcImage.BitCount) and (not SrcImage.PackedPixelOrder) then
9164
          (Integer(ddsd.ddpfPixelFormat.dwRGBBitCount) = SrcImage.BitCount) and (not SrcImage.PackedPixelOrder)
6081
        begin                
-
 
6082
          for y:=0 to ddsd.dwHeight-1 do
-
 
6083
            Move(SrcImage.ScanLine[y]^, Pointer(Integer(ddsd.lpSurface)+ddsd.lPitch*y)^, (Integer(ddsd.dwWidth)*SrcImage.BitCount+7) div 8);
-
 
6084
        end else
9165
        then
6085
        if SrcImage.rgb_alpha.mask<>0 then
-
 
6086
        begin
9166
        begin
6087
          for y:=0 to ddsd.dwHeight-1 do
9167
          for y := 0 to ddsd.dwHeight - 1 do
-
 
9168
            Move(SrcImage.ScanLine[y]^, Pointer(Integer(ddsd.lpSurface) + ddsd.lPitch * y)^, (Integer(ddsd.dwWidth) * SrcImage.BitCount + 7) div 8);
-
 
9169
        end
-
 
9170
        else
-
 
9171
          if SrcImage.rgb_alpha.mask <> 0 then
-
 
9172
          begin
-
 
9173
            for y := 0 to ddsd.dwHeight - 1 do
6088
            for x:=0 to ddsd.dwWidth-1 do
9174
              for x := 0 to ddsd.dwWidth - 1 do
6089
            begin
9175
              begin
6090
              c := SrcImage.Pixels[x, y];
9176
                c := SrcImage.Pixels[x, y];
6091
 
9177
 
6092
              c := dxtEncodeChannel(dest_red_fmt, dxtDecodeChannel(SrcImage.rgb_red, c)) or
9178
                c := dxtEncodeChannel(dest_red_fmt, dxtDecodeChannel(SrcImage.rgb_red, c)) or
6093
                dxtEncodeChannel(dest_green_fmt, dxtDecodeChannel(SrcImage.rgb_green, c)) or
9179
                  dxtEncodeChannel(dest_green_fmt, dxtDecodeChannel(SrcImage.rgb_green, c)) or
6094
                dxtEncodeChannel(dest_blue_fmt, dxtDecodeChannel(SrcImage.rgb_blue, c)) or
9180
                  dxtEncodeChannel(dest_blue_fmt, dxtDecodeChannel(SrcImage.rgb_blue, c)) or
6095
                dxtEncodeChannel(dest_alpha_fmt, dxtDecodeChannel(SrcImage.rgb_alpha, c));
9181
                  dxtEncodeChannel(dest_alpha_fmt, dxtDecodeChannel(SrcImage.rgb_alpha, c));
6096
 
9182
 
6097
              SetPixel(ddsd, x, y, c);
9183
                SetPixel(ddsd, x, y, c);
6098
            end;
9184
              end;
-
 
9185
          end
6099
        end else
9186
          else
6100
        begin
9187
          begin
6101
          cA := dxtEncodeChannel(dest_alpha_fmt, 255);
9188
            cA := dxtEncodeChannel(dest_alpha_fmt, 255);
6102
 
9189
 
6103
          for y:=0 to ddsd.dwHeight-1 do
9190
            for y := 0 to ddsd.dwHeight - 1 do
6104
            for x:=0 to ddsd.dwWidth-1 do
9191
              for x := 0 to ddsd.dwWidth - 1 do
6105
            begin
9192
              begin
6106
              c := SrcImage.Pixels[x, y];
9193
                c := SrcImage.Pixels[x, y];
6107
 
9194
 
6108
              c := dxtEncodeChannel(dest_red_fmt, dxtDecodeChannel(SrcImage.rgb_red, c)) or
9195
                c := dxtEncodeChannel(dest_red_fmt, dxtDecodeChannel(SrcImage.rgb_red, c)) or
6109
                dxtEncodeChannel(dest_green_fmt, dxtDecodeChannel(SrcImage.rgb_green, c)) or
9196
                  dxtEncodeChannel(dest_green_fmt, dxtDecodeChannel(SrcImage.rgb_green, c)) or
6110
                dxtEncodeChannel(dest_blue_fmt, dxtDecodeChannel(SrcImage.rgb_blue, c)) or cA;
9197
                  dxtEncodeChannel(dest_blue_fmt, dxtDecodeChannel(SrcImage.rgb_blue, c)) or cA;
6111
 
9198
 
6112
              SetPixel(ddsd, x, y, c);
9199
                SetPixel(ddsd, x, y, c);
6113
            end;
9200
              end;
6114
        end;
9201
          end;
6115
      finally
9202
      finally
6116
        Dest.UnLock(ddsd.lpSurface);
9203
        Dest.UnLock(ddsd.lpSurface);
6117
      end;
9204
      end;
6118
    end;
9205
    end;
6119
  end;
9206
  end;
Line 6122... Line 9209...
6122
  SurfaceDesc: TDDSurfaceDesc2;
9209
  SurfaceDesc: TDDSurfaceDesc2;
6123
begin
9210
begin
6124
  SurfaceDesc.dwSize := SizeOf(SurfaceDesc);
9211
  SurfaceDesc.dwSize := SizeOf(SurfaceDesc);
6125
  Dest.GetSurfaceDesc(SurfaceDesc);
9212
  Dest.GetSurfaceDesc(SurfaceDesc);
6126
 
9213
 
6127
  if SurfaceDesc.ddpfPixelFormat.dwFlags and DDPF_PALETTEINDEXED<>0 then
9214
  if SurfaceDesc.ddpfPixelFormat.dwFlags and DDPF_PALETTEINDEXED <> 0 then
6128
  begin
9215
  begin
6129
    case SrcImage.ImageType of
9216
    case SrcImage.ImageType of
6130
      DXTextureImageType_PaletteIndexedColor: LoadTexture_IndexToIndex;
9217
      DXTextureImageType_PaletteIndexedColor: LoadTexture_IndexToIndex;
6131
      DXTextureImageType_RGBColor           : ;
9218
      DXTextureImageType_RGBColor: ;
6132
    end;
9219
    end;
6133
  end else if SurfaceDesc.ddpfPixelFormat.dwFlags and DDPF_RGB<>0 then
9220
  end else if SurfaceDesc.ddpfPixelFormat.dwFlags and DDPF_RGB <> 0 then
6134
  begin
9221
  begin
6135
    case SrcImage.ImageType of
9222
    case SrcImage.ImageType of
6136
      DXTextureImageType_PaletteIndexedColor: LoadTexture_IndexToRGB;
9223
      DXTextureImageType_PaletteIndexedColor: LoadTexture_IndexToRGB;
6137
      DXTextureImageType_RGBColor           : LoadTexture_RGBToRGB;
9224
      DXTextureImageType_RGBColor: LoadTexture_RGBToRGB;
-
 
9225
    end;
-
 
9226
  end;
-
 
9227
end;
-
 
9228
 
-
 
9229
{ Support function }
-
 
9230
 
-
 
9231
function GetWidthBytes(Width, BitCount: Integer): Integer;
-
 
9232
begin
-
 
9233
  Result := (((Width * BitCount) + 31) div 32) * 4;
-
 
9234
end;
-
 
9235
 
-
 
9236
function dxtEncodeChannel(const Channel: TDXTextureImageChannel; c: DWORD): DWORD;
-
 
9237
begin
-
 
9238
  Result := ((c shl Channel._rshift) shr Channel._lshift) and Channel.Mask;
-
 
9239
end;
-
 
9240
 
-
 
9241
function dxtDecodeChannel(const Channel: TDXTextureImageChannel; c: DWORD): DWORD;
-
 
9242
begin
-
 
9243
  Result := ((c and Channel.Mask) shr Channel._rshift) shl Channel._lshift;
-
 
9244
  Result := Result or (Result shr Channel._BitCount2);
-
 
9245
end;
-
 
9246
 
-
 
9247
function dxtMakeChannel(Mask: DWORD; indexed: Boolean): TDXTextureImageChannel;
-
 
9248
 
-
 
9249
  function GetMaskBitCount(b: Integer): Integer;
-
 
9250
  var
-
 
9251
    i: Integer;
-
 
9252
  begin
-
 
9253
    i := 0;
-
 
9254
    while (i < 31) and (((1 shl i) and b) = 0) do Inc(i);
-
 
9255
 
-
 
9256
    Result := 0;
-
 
9257
    while ((1 shl i) and b) <> 0 do
-
 
9258
    begin
-
 
9259
      Inc(i);
-
 
9260
      Inc(Result);
-
 
9261
    end;
-
 
9262
  end;
-
 
9263
 
-
 
9264
  function GetBitCount2(b: Integer): Integer;
-
 
9265
  begin
-
 
9266
    Result := 0;
-
 
9267
    while (Result < 31) and (((1 shl Result) and b) = 0) do Inc(Result);
-
 
9268
  end;
-
 
9269
 
-
 
9270
begin
-
 
9271
  Result.BitCount := GetMaskBitCount(Mask);
-
 
9272
  Result.Mask := Mask;
-
 
9273
 
-
 
9274
  if indexed then
-
 
9275
  begin
-
 
9276
    Result._rshift := GetBitCount2(Mask);
-
 
9277
    Result._lshift := 0;
-
 
9278
    Result._Mask2 := 1 shl Result.BitCount - 1;
-
 
9279
    Result._BitCount2 := 0;
-
 
9280
  end
-
 
9281
  else
-
 
9282
  begin
-
 
9283
    Result._rshift := GetBitCount2(Mask) - (8 - Result.BitCount);
-
 
9284
    if Result._rshift < 0 then
-
 
9285
    begin
-
 
9286
      Result._lshift := -Result._rshift;
-
 
9287
      Result._rshift := 0;
-
 
9288
    end
-
 
9289
    else
-
 
9290
      Result._lshift := 0;
-
 
9291
    Result._Mask2 := (1 shl Result.BitCount - 1) shl (8 - Result.BitCount);
-
 
9292
    Result._BitCount2 := 8 - Result.BitCount;
-
 
9293
  end;
-
 
9294
end;
-
 
9295
 
-
 
9296
{  TDXTextureImage  }
-
 
9297
 
-
 
9298
var
-
 
9299
  _DXTextureImageLoadFuncList: TList;
-
 
9300
 
-
 
9301
procedure DXTextureImage_LoadDXTextureImageFunc(Stream: TStream; Image: TDXTextureImage); forward;
-
 
9302
procedure DXTextureImage_LoadBitmapFunc(Stream: TStream; Image: TDXTextureImage); forward;
-
 
9303
 
-
 
9304
function DXTextureImageLoadFuncList: TList;
-
 
9305
begin
-
 
9306
  if _DXTextureImageLoadFuncList = nil then
-
 
9307
  begin
-
 
9308
    _DXTextureImageLoadFuncList := TList.Create;
-
 
9309
    _DXTextureImageLoadFuncList.Add(@DXTextureImage_LoadDXTextureImageFunc);
-
 
9310
    _DXTextureImageLoadFuncList.Add(@DXTextureImage_LoadBitmapFunc);
-
 
9311
  end;
-
 
9312
  Result := _DXTextureImageLoadFuncList;
-
 
9313
end;
-
 
9314
 
-
 
9315
class procedure TDXTextureImage.RegisterLoadFunc(LoadFunc: TDXTextureImageLoadFunc);
-
 
9316
begin
-
 
9317
  if DXTextureImageLoadFuncList.IndexOf(@LoadFunc) = -1 then
-
 
9318
    DXTextureImageLoadFuncList.Add(@LoadFunc);
-
 
9319
end;
-
 
9320
 
-
 
9321
class procedure TDXTextureImage.UnRegisterLoadFunc(LoadFunc: TDXTextureImageLoadFunc);
-
 
9322
begin
-
 
9323
  DXTextureImageLoadFuncList.Remove(@LoadFunc);
-
 
9324
end;
-
 
9325
 
-
 
9326
constructor TDXTextureImage.Create;
-
 
9327
begin
-
 
9328
  inherited Create;
-
 
9329
  FSubImage := TList.Create;
-
 
9330
end;
-
 
9331
 
-
 
9332
constructor TDXTextureImage.CreateSub(AOwner: TDXTextureImage);
-
 
9333
begin
-
 
9334
  Create;
-
 
9335
 
-
 
9336
  FOwner := AOwner;
-
 
9337
  try
-
 
9338
    FOwner.FSubImage.Add(Self);
-
 
9339
  except
-
 
9340
    FOwner := nil;
-
 
9341
    raise;
-
 
9342
  end;
-
 
9343
end;
-
 
9344
 
-
 
9345
destructor TDXTextureImage.Destroy;
-
 
9346
begin
-
 
9347
  Clear;
-
 
9348
  FSubImage.Free;
-
 
9349
  if FOwner <> nil then
-
 
9350
    FOwner.FSubImage.Remove(Self);
-
 
9351
  inherited Destroy;
-
 
9352
end;
-
 
9353
 
-
 
9354
procedure TDXTextureImage.DoSaveProgress(Progress, ProgressCount: Integer);
-
 
9355
begin
-
 
9356
  if Assigned(FOnSaveProgress) then
-
 
9357
    FOnSaveProgress(Self, Progress, ProgressCount);
-
 
9358
end;
-
 
9359
 
-
 
9360
procedure TDXTextureImage.Assign(Source: TDXTextureImage);
-
 
9361
var
-
 
9362
  y: Integer;
-
 
9363
begin
-
 
9364
  SetSize(Source.ImageType, Source.Width, Source.Height, Source.BitCount, Source.WidthBytes);
-
 
9365
 
-
 
9366
  idx_index := Source.idx_index;
-
 
9367
  idx_alpha := Source.idx_alpha;
-
 
9368
  idx_palette := Source.idx_palette;
-
 
9369
 
-
 
9370
  rgb_red := Source.rgb_red;
-
 
9371
  rgb_green := Source.rgb_green;
-
 
9372
  rgb_blue := Source.rgb_blue;
-
 
9373
  rgb_alpha := Source.rgb_alpha;
-
 
9374
 
-
 
9375
  for y := 0 to Height - 1 do
-
 
9376
    Move(Source.ScanLine[y]^, ScanLine[y]^, WidthBytes);
-
 
9377
 
-
 
9378
  Transparent := Source.Transparent;
-
 
9379
  TransparentColor := Source.TransparentColor;
-
 
9380
  ImageGroupType := Source.ImageGroupType;
-
 
9381
  ImageID := Source.ImageID;
-
 
9382
  ImageName := Source.ImageName;
-
 
9383
end;
-
 
9384
 
-
 
9385
procedure TDXTextureImage.ClearImage;
-
 
9386
begin
-
 
9387
  if FAutoFreeImage then
-
 
9388
    FreeMem(FPBits);
-
 
9389
 
-
 
9390
  FImageType := DXTextureImageType_PaletteIndexedColor;
-
 
9391
  FWidth := 0;
-
 
9392
  FHeight := 0;
-
 
9393
  FBitCount := 0;
-
 
9394
  FWidthBytes := 0;
-
 
9395
  FNextLine := 0;
-
 
9396
  FSize := 0;
-
 
9397
  FPBits := nil;
-
 
9398
  FTopPBits := nil;
-
 
9399
  FAutoFreeImage := False;
-
 
9400
end;
-
 
9401
 
-
 
9402
procedure TDXTextureImage.Clear;
-
 
9403
begin
-
 
9404
  ClearImage;
-
 
9405
 
-
 
9406
  while SubImageCount > 0 do
-
 
9407
    SubImages[SubImageCount - 1].Free;
-
 
9408
 
-
 
9409
  FImageGroupType := 0;
-
 
9410
  FImageID := 0;
-
 
9411
  FImageName := '';
-
 
9412
 
-
 
9413
  FTransparent := False;
-
 
9414
  FTransparentColor := 0;
-
 
9415
 
-
 
9416
  FillChar(idx_index, SizeOf(idx_index), 0);
-
 
9417
  FillChar(idx_alpha, SizeOf(idx_alpha), 0);
-
 
9418
  FillChar(idx_palette, SizeOf(idx_palette), 0);
-
 
9419
  FillChar(rgb_red, SizeOf(rgb_red), 0);
-
 
9420
  FillChar(rgb_green, SizeOf(rgb_green), 0);
-
 
9421
  FillChar(rgb_blue, SizeOf(rgb_blue), 0);
-
 
9422
  FillChar(rgb_alpha, SizeOf(rgb_alpha), 0);
-
 
9423
end;
-
 
9424
 
-
 
9425
procedure TDXTextureImage.SetImage(ImageType: TDXTextureImageType; Width, Height, BitCount, WidthBytes, NextLine: Integer;
-
 
9426
  PBits, TopPBits: Pointer; Size: Integer; AutoFree: Boolean);
-
 
9427
begin
-
 
9428
  ClearImage;
-
 
9429
 
-
 
9430
  FAutoFreeImage := AutoFree;
-
 
9431
  FImageType := ImageType;
-
 
9432
  FWidth := Width;
-
 
9433
  FHeight := Height;
-
 
9434
  FBitCount := BitCount;
-
 
9435
  FWidthBytes := WidthBytes;
-
 
9436
  FNextLine := NextLine;
-
 
9437
  FSize := Size;
-
 
9438
  FPBits := PBits;
-
 
9439
  FTopPBits := TopPBits;
-
 
9440
end;
-
 
9441
 
-
 
9442
procedure TDXTextureImage.SetSize(ImageType: TDXTextureImageType; Width, Height, BitCount, WidthBytes: Integer);
-
 
9443
var
-
 
9444
  APBits: Pointer;
-
 
9445
begin
-
 
9446
  ClearImage;
-
 
9447
 
-
 
9448
  if WidthBytes = 0 then
-
 
9449
    WidthBytes := GetWidthBytes(Width, BitCount);
-
 
9450
 
-
 
9451
  GetMem(APBits, WidthBytes * Height);
-
 
9452
  SetImage(ImageType, Width, Height, BitCount, WidthBytes,
-
 
9453
    WidthBytes, APBits, APBits, WidthBytes * Height, True);
-
 
9454
end;
-
 
9455
 
-
 
9456
function TDXTextureImage.GetScanLine(y: Integer): Pointer;
-
 
9457
begin
-
 
9458
  Result := Pointer(Integer(FTopPBits) + FNextLine * y);
-
 
9459
end;
-
 
9460
 
-
 
9461
function TDXTextureImage.GetSubGroupImageCount(GroupTypeID: DWORD): Integer;
-
 
9462
var
-
 
9463
  i: Integer;
-
 
9464
begin
-
 
9465
  Result := 0;
-
 
9466
  for i := 0 to SubImageCount - 1 do
-
 
9467
    if SubImages[i].ImageGroupType = GroupTypeID then
-
 
9468
      Inc(Result);
-
 
9469
end;
-
 
9470
 
-
 
9471
function TDXTextureImage.GetSubGroupImage(GroupTypeID: DWORD; Index: Integer): TDXTextureImage;
-
 
9472
var
-
 
9473
  i, j: Integer;
-
 
9474
begin
-
 
9475
  j := 0;
-
 
9476
  for i := 0 to SubImageCount - 1 do
-
 
9477
    if SubImages[i].ImageGroupType = GroupTypeID then
-
 
9478
    begin
-
 
9479
      if j = Index then
-
 
9480
      begin
-
 
9481
        Result := SubImages[i];
-
 
9482
        Exit;
-
 
9483
      end;
-
 
9484
 
-
 
9485
      Inc(j);
-
 
9486
    end;
-
 
9487
 
-
 
9488
  Result := nil;
-
 
9489
  SubImages[-1];
-
 
9490
end;
-
 
9491
 
-
 
9492
function TDXTextureImage.GetSubImageCount: Integer;
-
 
9493
begin
-
 
9494
  Result := 0;
-
 
9495
  if Assigned(FSubImage) then
-
 
9496
    Result := FSubImage.Count;
-
 
9497
end;
-
 
9498
 
-
 
9499
function TDXTextureImage.GetSubImage(Index: Integer): TDXTextureImage;
-
 
9500
begin
-
 
9501
  Result := FSubImage[Index];
-
 
9502
end;
-
 
9503
 
-
 
9504
function TDXTextureImage.EncodeColor(R, G, B, A: Byte): DWORD;
-
 
9505
begin
-
 
9506
  if ImageType = DXTextureImageType_PaletteIndexedColor then
-
 
9507
  begin
-
 
9508
    Result := dxtEncodeChannel(idx_index, PaletteIndex(R, G, B)) or
-
 
9509
      dxtEncodeChannel(idx_alpha, A);
-
 
9510
  end
-
 
9511
  else
-
 
9512
  begin
-
 
9513
    Result := dxtEncodeChannel(rgb_red, R) or
-
 
9514
      dxtEncodeChannel(rgb_green, G) or
-
 
9515
      dxtEncodeChannel(rgb_blue, B) or
-
 
9516
      dxtEncodeChannel(rgb_alpha, A);
-
 
9517
  end;
-
 
9518
end;
-
 
9519
 
-
 
9520
function TDXTextureImage.PaletteIndex(R, G, B: Byte): DWORD;
-
 
9521
var
-
 
9522
  i, d, d2: Integer;
-
 
9523
begin
-
 
9524
  Result := 0;
-
 
9525
  if ImageType = DXTextureImageType_PaletteIndexedColor then
-
 
9526
  begin
-
 
9527
    d := MaxInt;
-
 
9528
    for i := 0 to (1 shl idx_index.BitCount) - 1 do
-
 
9529
      with idx_palette[i] do
-
 
9530
      begin
-
 
9531
        d2 := Abs((peRed - R)) * Abs((peRed - R)) + Abs((peGreen - G)) * Abs((peGreen - G)) + Abs((peBlue - B)) * Abs((peBlue - B));
-
 
9532
        if d > d2 then
-
 
9533
        begin
-
 
9534
          d := d2;
-
 
9535
          Result := i;
-
 
9536
        end;
-
 
9537
      end;
-
 
9538
  end;
-
 
9539
end;
-
 
9540
 
-
 
9541
const
-
 
9542
  Mask1: array[0..7] of DWORD = (1, 2, 4, 8, 16, 32, 64, 128);
-
 
9543
  Mask2: array[0..3] of DWORD = (3, 12, 48, 192);
-
 
9544
  Mask4: array[0..1] of DWORD = ($0F, $F0);
-
 
9545
 
-
 
9546
  Shift1: array[0..7] of DWORD = (0, 1, 2, 3, 4, 5, 6, 7);
-
 
9547
  Shift2: array[0..3] of DWORD = (0, 2, 4, 6);
-
 
9548
  Shift4: array[0..1] of DWORD = (0, 4);
-
 
9549
 
-
 
9550
type
-
 
9551
  PByte3 = ^TByte3;
-
 
9552
  TByte3 = array[0..2] of Byte;
-
 
9553
 
-
 
9554
function TDXTextureImage.GetPixel(x, y: Integer): DWORD;
-
 
9555
begin
-
 
9556
  Result := 0;
-
 
9557
  if (x >= 0) and (x < FWidth) and (y >= 0) and (y < FHeight) then
-
 
9558
  begin
-
 
9559
    case FBitCount of
-
 
9560
      1: begin
-
 
9561
          if FPackedPixelOrder then
-
 
9562
            Result := (PByte(Integer(FTopPBits) + FNextLine * y + x shr 3)^ and Mask1[7 - x and 7]) shr Shift1[7 - x and 7]
-
 
9563
          else
-
 
9564
            Result := (PByte(Integer(FTopPBits) + FNextLine * y + x shr 3)^ and Mask1[x and 7]) shr Shift1[x and 7];
-
 
9565
        end;
-
 
9566
      2: begin
-
 
9567
          if FPackedPixelOrder then
-
 
9568
            Result := (PByte(Integer(FTopPBits) + FNextLine * y + x shr 2)^ and Mask2[3 - x and 3]) shr Shift2[3 - x and 3]
-
 
9569
          else
-
 
9570
            Result := (PByte(Integer(FTopPBits) + FNextLine * y + x shr 2)^ and Mask2[x and 3]) shr Shift2[x and 3];
-
 
9571
        end;
-
 
9572
      4: begin
-
 
9573
          if FPackedPixelOrder then
-
 
9574
            Result := (PByte(Integer(FTopPBits) + FNextLine * y + x shr 1)^ and Mask4[1 - x and 1]) shr Shift4[1 - x and 1]
-
 
9575
          else
-
 
9576
            Result := (PByte(Integer(FTopPBits) + FNextLine * y + x shr 1)^ and Mask4[x and 1]) shr Shift4[x and 1];
-
 
9577
        end;
-
 
9578
      8: Result := PByte(Integer(FTopPBits) + FNextLine * y + x)^;
-
 
9579
      16: Result := PWord(Integer(FTopPBits) + FNextLine * y + x * 2)^;
-
 
9580
      24: PByte3(@Result)^ := PByte3(Integer(FTopPBits) + FNextLine * y + x * 3)^;
-
 
9581
      32: Result := PDWORD(Integer(FTopPBits) + FNextLine * y + x * 4)^;
-
 
9582
    end;
-
 
9583
  end;
-
 
9584
end;
-
 
9585
 
-
 
9586
procedure TDXTextureImage.SetPixel(x, y: Integer; c: DWORD);
-
 
9587
var
-
 
9588
  P: PByte;
-
 
9589
begin
-
 
9590
  if (x >= 0) and (x < FWidth) and (y >= 0) and (y < FHeight) then
-
 
9591
  begin
-
 
9592
    case FBitCount of
-
 
9593
      1: begin
-
 
9594
          P := Pointer(Integer(FTopPBits) + FNextLine * y + x shr 3);
-
 
9595
          if FPackedPixelOrder then
-
 
9596
            P^ := (P^ and (not Mask1[7 - x and 7])) or ((c and 1) shl Shift1[7 - x and 7])
-
 
9597
          else
-
 
9598
            P^ := (P^ and (not Mask1[x and 7])) or ((c and 1) shl Shift1[x and 7]);
-
 
9599
        end;
-
 
9600
      2: begin
-
 
9601
          P := Pointer(Integer(FTopPBits) + FNextLine * y + x shr 2);
-
 
9602
          if FPackedPixelOrder then
-
 
9603
            P^ := (P^ and (not Mask2[3 - x and 3])) or ((c and 3) shl Shift2[3 - x and 3])
-
 
9604
          else
-
 
9605
            P^ := (P^ and (not Mask2[x and 3])) or ((c and 3) shl Shift2[x and 3]);
-
 
9606
        end;
-
 
9607
      4: begin
-
 
9608
          P := Pointer(Integer(FTopPBits) + FNextLine * y + x shr 1);
-
 
9609
          if FPackedPixelOrder then
-
 
9610
            P^ := (P^ and (not Mask4[1 - x and 1])) or ((c and 7) shl Shift4[1 - x and 1])
-
 
9611
          else
-
 
9612
            P^ := (P^ and (not Mask4[x and 1])) or ((c and 7) shl Shift4[x and 1]);
-
 
9613
        end;
-
 
9614
      8: PByte(Integer(FTopPBits) + FNextLine * y + x)^ := c;
-
 
9615
      16: PWord(Integer(FTopPBits) + FNextLine * y + x * 2)^ := c;
-
 
9616
      24: PByte3(Integer(FTopPBits) + FNextLine * y + x * 3)^ := PByte3(@c)^;
-
 
9617
      32: PDWORD(Integer(FTopPBits) + FNextLine * y + x * 4)^ := c;
-
 
9618
    end;
-
 
9619
  end;
-
 
9620
end;
-
 
9621
 
-
 
9622
procedure TDXTextureImage.LoadFromFile(const FileName: string);
-
 
9623
var
-
 
9624
  Stream: TFileStream;
-
 
9625
begin
-
 
9626
  Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
-
 
9627
  try
-
 
9628
    LoadFromStream(Stream);
-
 
9629
  finally
-
 
9630
    Stream.Free;
-
 
9631
  end;
-
 
9632
end;
-
 
9633
 
-
 
9634
procedure TDXTextureImage.LoadFromStream(Stream: TStream);
-
 
9635
var
-
 
9636
  i, p: Integer;
-
 
9637
begin
-
 
9638
  Clear;
-
 
9639
 
-
 
9640
  p := Stream.Position;
-
 
9641
  for i := 0 to DXTextureImageLoadFuncList.Count - 1 do
-
 
9642
  begin
-
 
9643
    Stream.Position := p;
-
 
9644
    try
-
 
9645
      TDXTextureImageLoadFunc(DXTextureImageLoadFuncList[i])(Stream, Self);
-
 
9646
      Exit;
-
 
9647
    except
-
 
9648
      Clear;
-
 
9649
    end;
-
 
9650
  end;
-
 
9651
 
-
 
9652
  raise EDXTextureImageError.Create(SNotSupportGraphicFile);
-
 
9653
end;
-
 
9654
 
-
 
9655
procedure TDXTextureImage.SaveToFile(const FileName: string);
-
 
9656
var
-
 
9657
  Stream: TFileStream;
-
 
9658
begin
-
 
9659
  Stream := TFileStream.Create(FileName, fmCreate);
-
 
9660
  try
-
 
9661
    SaveToStream(Stream);
-
 
9662
  finally
-
 
9663
    Stream.Free;
-
 
9664
  end;
-
 
9665
end;
-
 
9666
 
-
 
9667
procedure DXTextureImage_SaveDXTextureImageFunc(Stream: TStream; Image: TDXTextureImage); forward;
-
 
9668
 
-
 
9669
procedure TDXTextureImage.SaveToStream(Stream: TStream);
-
 
9670
begin
-
 
9671
  DXTextureImage_SaveDXTextureImageFunc(Stream, Self);
-
 
9672
end;
-
 
9673
 
-
 
9674
{  DXTextureImage_LoadDXTextureImageFunc  }
-
 
9675
 
-
 
9676
const
-
 
9677
  DXTextureImageFile_Type = 'dxt:';
-
 
9678
  DXTextureImageFile_Version = $100;
-
 
9679
 
-
 
9680
  DXTextureImageCompress_None = 0;
-
 
9681
  DXTextureImageCompress_ZLIB = 1; // ZLIB enabled
-
 
9682
 
-
 
9683
  DXTextureImageFileCategoryType_Image = $100;
-
 
9684
 
-
 
9685
  DXTextureImageFileBlockID_EndFile = 0;
-
 
9686
  DXTextureImageFileBlockID_EndGroup = 1;
-
 
9687
  DXTextureImageFileBlockID_StartGroup = 2;
-
 
9688
  DXTextureImageFileBlockID_Image_Format = DXTextureImageFileCategoryType_Image + 1;
-
 
9689
  DXTextureImageFileBlockID_Image_PixelData = DXTextureImageFileCategoryType_Image + 2;
-
 
9690
  DXTextureImageFileBlockID_Image_GroupInfo = DXTextureImageFileCategoryType_Image + 3;
-
 
9691
  DXTextureImageFileBlockID_Image_Name = DXTextureImageFileCategoryType_Image + 4;
-
 
9692
  DXTextureImageFileBlockID_Image_TransparentColor = DXTextureImageFileCategoryType_Image + 5;
-
 
9693
 
-
 
9694
type
-
 
9695
  TDXTextureImageFileHeader = packed record
-
 
9696
    FileType: array[0..4] of Char;
-
 
9697
    ver: DWORD;
-
 
9698
  end;
-
 
9699
 
-
 
9700
  TDXTextureImageFileBlockHeader = packed record
-
 
9701
    ID: DWORD;
-
 
9702
    Size: Integer;
-
 
9703
  end;
-
 
9704
 
-
 
9705
  TDXTextureImageFileBlockHeader_StartGroup = packed record
-
 
9706
    CategoryType: DWORD;
-
 
9707
  end;
-
 
9708
 
-
 
9709
  TDXTextureImageHeader_Image_Format = packed record
-
 
9710
    ImageType: TDXTextureImageType;
-
 
9711
    Width: DWORD;
-
 
9712
    Height: DWORD;
-
 
9713
    BitCount: DWORD;
-
 
9714
    WidthBytes: DWORD;
-
 
9715
  end;
-
 
9716
 
-
 
9717
  TDXTextureImageHeader_Image_Format_Index = packed record
-
 
9718
    idx_index_Mask: DWORD;
-
 
9719
    idx_alpha_Mask: DWORD;
-
 
9720
    idx_palette: array[0..255] of TPaletteEntry;
-
 
9721
  end;
-
 
9722
 
-
 
9723
  TDXTextureImageHeader_Image_Format_RGB = packed record
-
 
9724
    rgb_red_Mask: DWORD;
-
 
9725
    rgb_green_Mask: DWORD;
-
 
9726
    rgb_blue_Mask: DWORD;
-
 
9727
    rgb_alpha_Mask: DWORD;
-
 
9728
  end;
-
 
9729
 
-
 
9730
  TDXTextureImageHeader_Image_GroupInfo = packed record
-
 
9731
    ImageGroupType: DWORD;
-
 
9732
    ImageID: DWORD;
-
 
9733
  end;
-
 
9734
 
-
 
9735
  TDXTextureImageHeader_Image_PixelData = packed record
-
 
9736
    Compress: DWORD;
-
 
9737
  end;
-
 
9738
 
-
 
9739
  TDXTextureImageHeader_Image_TransparentColor = packed record
-
 
9740
    Transparent: Boolean;
-
 
9741
    TransparentColor: DWORD;
-
 
9742
  end;
-
 
9743
 
-
 
9744
procedure DXTextureImage_LoadDXTextureImageFunc(Stream: TStream; Image: TDXTextureImage);
-
 
9745
 
-
 
9746
  procedure ReadGroup_Image(Image: TDXTextureImage);
-
 
9747
  var
-
 
9748
    i: Integer;
-
 
9749
    BlockHeader: TDXTextureImageFileBlockHeader;
-
 
9750
    NextPos: Integer;
-
 
9751
    SubImage: TDXTextureImage;
-
 
9752
    Header_StartGroup: TDXTextureImageFileBlockHeader_StartGroup;
-
 
9753
    Header_Image_Format: TDXTextureImageHeader_Image_Format;
-
 
9754
    Header_Image_Format_Index: TDXTextureImageHeader_Image_Format_Index;
-
 
9755
    Header_Image_Format_RGB: TDXTextureImageHeader_Image_Format_RGB;
-
 
9756
    Header_Image_GroupInfo: TDXTextureImageHeader_Image_GroupInfo;
-
 
9757
    Header_Image_TransparentColor: TDXTextureImageHeader_Image_TransparentColor;
-
 
9758
    Header_Image_PixelData: TDXTextureImageHeader_Image_PixelData;
-
 
9759
    ImageName: string;
-
 
9760
    {$IFDEF DXTextureImage_UseZLIB}
-
 
9761
    Decompression: TDecompressionStream;
-
 
9762
    {$ENDIF}
-
 
9763
  begin
-
 
9764
    while True do
-
 
9765
    begin
-
 
9766
      Stream.ReadBuffer(BlockHeader, SizeOf(BlockHeader));
-
 
9767
      NextPos := Stream.Position + BlockHeader.Size;
-
 
9768
 
-
 
9769
      case BlockHeader.ID of
-
 
9770
        DXTextureImageFileBlockID_EndGroup:
-
 
9771
          begin
-
 
9772
            {  End of group  }
-
 
9773
            Break;
-
 
9774
          end;
-
 
9775
        DXTextureImageFileBlockID_StartGroup:
-
 
9776
          begin
-
 
9777
            {  Beginning of group  }
-
 
9778
            Stream.ReadBuffer(Header_StartGroup, SizeOf(Header_StartGroup));
-
 
9779
            case Header_StartGroup.CategoryType of
-
 
9780
              DXTextureImageFileCategoryType_Image:
-
 
9781
                begin
-
 
9782
                  {  Image group  }
-
 
9783
                  SubImage := TDXTextureImage.CreateSub(Image);
-
 
9784
                  try
-
 
9785
                    ReadGroup_Image(SubImage);
-
 
9786
                  except
-
 
9787
                    SubImage.Free;
-
 
9788
                    raise;
-
 
9789
                  end;
-
 
9790
                end;
-
 
9791
            end;
-
 
9792
          end;
-
 
9793
        DXTextureImageFileBlockID_Image_Format:
-
 
9794
          begin
-
 
9795
            {  Image information reading (size etc.)  }
-
 
9796
            Stream.ReadBuffer(Header_Image_Format, SizeOf(Header_Image_Format));
-
 
9797
 
-
 
9798
            if (Header_Image_Format.ImageType <> DXTextureImageType_PaletteIndexedColor) and
-
 
9799
              (Header_Image_Format.ImageType <> DXTextureImageType_RGBColor)
-
 
9800
            then
-
 
9801
              raise EDXTextureImageError.Create(SInvalidDXTFile);
-
 
9802
 
-
 
9803
            Image.SetSize(Header_Image_Format.ImageType, Header_Image_Format.Width, Header_Image_Format.Height,
-
 
9804
              Header_Image_Format.BitCount, Header_Image_Format.Widthbytes);
-
 
9805
 
-
 
9806
            if Header_Image_Format.ImageType = DXTextureImageType_PaletteIndexedColor then
-
 
9807
            begin
-
 
9808
              {  INDEX IMAGE  }
-
 
9809
              Stream.ReadBuffer(Header_Image_Format_Index, SizeOf(Header_Image_Format_Index));
-
 
9810
 
-
 
9811
              Image.idx_index := dxtMakeChannel(Header_Image_Format_Index.idx_index_Mask, True);
-
 
9812
              Image.idx_alpha := dxtMakeChannel(Header_Image_Format_Index.idx_alpha_Mask, False);
-
 
9813
 
-
 
9814
              for i := 0 to 255 do
-
 
9815
                Image.idx_palette[i] := Header_Image_Format_Index.idx_palette[i];
-
 
9816
            end
-
 
9817
            else
-
 
9818
            if Header_Image_Format.ImageType = DXTextureImageType_RGBColor then
-
 
9819
            begin
-
 
9820
              {  RGB IMAGE  }
-
 
9821
              Stream.ReadBuffer(Header_Image_Format_RGB, SizeOf(Header_Image_Format_RGB));
-
 
9822
 
-
 
9823
              Image.rgb_red := dxtMakeChannel(Header_Image_Format_RGB.rgb_red_Mask, False);
-
 
9824
              Image.rgb_green := dxtMakeChannel(Header_Image_Format_RGB.rgb_green_Mask, False);
-
 
9825
              Image.rgb_blue := dxtMakeChannel(Header_Image_Format_RGB.rgb_blue_Mask, False);
-
 
9826
              Image.rgb_alpha := dxtMakeChannel(Header_Image_Format_RGB.rgb_alpha_Mask, False);
-
 
9827
            end;
-
 
9828
          end;
-
 
9829
        DXTextureImageFileBlockID_Image_Name:
-
 
9830
          begin
-
 
9831
            {  Name reading  }
-
 
9832
            SetLength(ImageName, BlockHeader.Size);
-
 
9833
            Stream.ReadBuffer(ImageName[1], BlockHeader.Size);
-
 
9834
 
-
 
9835
            Image.ImageName := ImageName;
-
 
9836
          end;
-
 
9837
        DXTextureImageFileBlockID_Image_GroupInfo:
-
 
9838
          begin
-
 
9839
            {  Image group information reading  }
-
 
9840
            Stream.ReadBuffer(Header_Image_GroupInfo, SizeOf(Header_Image_GroupInfo));
-
 
9841
 
-
 
9842
            Image.ImageGroupType := Header_Image_GroupInfo.ImageGroupType;
-
 
9843
            Image.ImageID := Header_Image_GroupInfo.ImageID;
-
 
9844
          end;
-
 
9845
        DXTextureImageFileBlockID_Image_TransparentColor:
-
 
9846
          begin
-
 
9847
            {  Transparent color information reading  }
-
 
9848
            Stream.ReadBuffer(Header_Image_TransparentColor, SizeOf(Header_Image_TransparentColor));
-
 
9849
 
-
 
9850
            Image.Transparent := Header_Image_TransparentColor.Transparent;
-
 
9851
            Image.TransparentColor := Header_Image_TransparentColor.TransparentColor;
-
 
9852
          end;
-
 
9853
        DXTextureImageFileBlockID_Image_PixelData:
-
 
9854
          begin
-
 
9855
            {  Pixel data reading  }
-
 
9856
            Stream.ReadBuffer(Header_Image_PixelData, SizeOf(Header_Image_PixelData));
-
 
9857
 
-
 
9858
            case Header_Image_PixelData.Compress of
-
 
9859
              DXTextureImageCompress_None:
-
 
9860
                begin
-
 
9861
                   {  NO compress  }
-
 
9862
                  for i := 0 to Image.Height - 1 do
-
 
9863
                    Stream.ReadBuffer(Image.ScanLine[i]^, Header_Image_Format.Widthbytes);
-
 
9864
                end;
-
 
9865
              {$IFDEF DXTextureImage_UseZLIB}
-
 
9866
              DXTextureImageCompress_ZLIB:
-
 
9867
                begin
-
 
9868
                   {  ZLIB compress enabled  }
-
 
9869
                  Decompression := TDecompressionStream.Create(Stream);
-
 
9870
                  try
-
 
9871
                    for i := 0 to Image.Height - 1 do
-
 
9872
                      Decompression.ReadBuffer(Image.ScanLine[i]^, Header_Image_Format.Widthbytes);
-
 
9873
                  finally
-
 
9874
                    Decompression.Free;
-
 
9875
                  end;
-
 
9876
                end;
-
 
9877
              {$ENDIF}
-
 
9878
            else
-
 
9879
              raise EDXTextureImageError.CreateFmt('Decompression error (%d)', [Header_Image_PixelData.Compress]);
-
 
9880
            end;
-
 
9881
          end;
-
 
9882
 
-
 
9883
      end;
-
 
9884
 
-
 
9885
      Stream.Seek(NextPos, soFromBeginning);
-
 
9886
    end;
-
 
9887
  end;
-
 
9888
 
-
 
9889
var
-
 
9890
  FileHeader: TDXTextureImageFileHeader;
-
 
9891
  BlockHeader: TDXTextureImageFileBlockHeader;
-
 
9892
  Header_StartGroup: TDXTextureImageFileBlockHeader_StartGroup;
-
 
9893
  NextPos: Integer;
-
 
9894
begin
-
 
9895
  {  File header reading  }
-
 
9896
  Stream.ReadBuffer(FileHeader, SizeOf(FileHeader));
-
 
9897
 
-
 
9898
  if FileHeader.FileType <> DXTextureImageFile_Type then
-
 
9899
    raise EDXTextureImageError.Create(SInvalidDXTFile);
-
 
9900
  if FileHeader.ver <> DXTextureImageFile_Version then
-
 
9901
    raise EDXTextureImageError.Create(SInvalidDXTFile);
-
 
9902
 
-
 
9903
  while True do
-
 
9904
  begin
-
 
9905
    Stream.ReadBuffer(BlockHeader, SizeOf(BlockHeader));
-
 
9906
    NextPos := Stream.Position + BlockHeader.Size;
-
 
9907
 
-
 
9908
    case BlockHeader.ID of
-
 
9909
      DXTextureImageFileBlockID_EndFile:
-
 
9910
        begin
-
 
9911
          {  End of file  }
-
 
9912
          Break;
-
 
9913
        end;
-
 
9914
      DXTextureImageFileBlockID_StartGroup:
-
 
9915
        begin
-
 
9916
          {  Beginning of group  }
-
 
9917
          Stream.ReadBuffer(Header_StartGroup, SizeOf(Header_StartGroup));
-
 
9918
          case Header_StartGroup.CategoryType of
-
 
9919
            DXTextureImageFileCategoryType_Image: ReadGroup_Image(Image);
-
 
9920
          end;
-
 
9921
        end;
6138
    end;
9922
    end;
-
 
9923
 
-
 
9924
    Stream.Seek(NextPos, soFromBeginning);
6139
  end;
9925
  end;
6140
end;
9926
end;
6141
 
9927
 
-
 
9928
type
-
 
9929
  PDXTextureImageFileBlockHeaderWriter_BlockInfo = ^TDXTextureImageFileBlockHeaderWriter_BlockInfo;
-
 
9930
  TDXTextureImageFileBlockHeaderWriter_BlockInfo = record
-
 
9931
    BlockID: DWORD;
-
 
9932
    StreamPos: Integer;
-
 
9933
  end;
-
 
9934
 
-
 
9935
  TDXTextureImageFileBlockHeaderWriter = class
-
 
9936
  private
-
 
9937
    FStream: TStream;
-
 
9938
    FList: TList;
-
 
9939
  public
-
 
9940
    constructor Create(Stream: TStream);
-
 
9941
    destructor Destroy; override;
-
 
9942
    procedure StartBlock(BlockID: DWORD);
-
 
9943
    procedure EndBlock;
-
 
9944
    procedure WriteBlock(BlockID: DWORD);
-
 
9945
    procedure StartGroup(CategoryType: DWORD);
-
 
9946
    procedure EndGroup;
-
 
9947
  end;
-
 
9948
 
-
 
9949
constructor TDXTextureImageFileBlockHeaderWriter.Create(Stream: TStream);
-
 
9950
begin
-
 
9951
  inherited Create;
-
 
9952
  FStream := Stream;
-
 
9953
  FList := TList.Create;
-
 
9954
end;
-
 
9955
 
-
 
9956
destructor TDXTextureImageFileBlockHeaderWriter.Destroy;
-
 
9957
var
-
 
9958
  i: Integer;
-
 
9959
begin
-
 
9960
  for i := 0 to FList.Count - 1 do
-
 
9961
    Dispose(PDXTextureImageFileBlockHeaderWriter_BlockInfo(FList[i]));
-
 
9962
  FList.Free;
-
 
9963
  inherited Destroy;
-
 
9964
end;
-
 
9965
 
-
 
9966
procedure TDXTextureImageFileBlockHeaderWriter.StartBlock(BlockID: DWORD);
-
 
9967
var
-
 
9968
  BlockInfo: PDXTextureImageFileBlockHeaderWriter_BlockInfo;
-
 
9969
  BlockHeader: TDXTextureImageFileBlockHeader;
-
 
9970
begin
-
 
9971
  New(BlockInfo);
-
 
9972
  BlockInfo.BlockID := BlockID;
-
 
9973
  BlockInfo.StreamPos := FStream.Position;
-
 
9974
  FList.Add(BlockInfo);
-
 
9975
 
-
 
9976
  BlockHeader.ID := BlockID;
-
 
9977
  BlockHeader.Size := 0;
-
 
9978
  FStream.WriteBuffer(BlockHeader, SizeOf(BlockHeader));
-
 
9979
end;
-
 
9980
 
-
 
9981
procedure TDXTextureImageFileBlockHeaderWriter.EndBlock;
-
 
9982
var
-
 
9983
  BlockHeader: TDXTextureImageFileBlockHeader;
-
 
9984
  BlockInfo: PDXTextureImageFileBlockHeaderWriter_BlockInfo;
-
 
9985
  CurStreamPos: Integer;
-
 
9986
begin
-
 
9987
  CurStreamPos := FStream.Position;
-
 
9988
  try
-
 
9989
    BlockInfo := FList[FList.Count - 1];
-
 
9990
 
-
 
9991
    FStream.Position := BlockInfo.StreamPos;
-
 
9992
    BlockHeader.ID := BlockInfo.BlockID;
-
 
9993
    BlockHeader.Size := CurStreamPos - (BlockInfo.StreamPos + SizeOf(TDXTextureImageFileBlockHeader));
-
 
9994
    FStream.WriteBuffer(BlockHeader, SizeOf(BlockHeader));
-
 
9995
  finally
-
 
9996
    FStream.Position := CurStreamPos;
-
 
9997
 
-
 
9998
    Dispose(FList[FList.Count - 1]);
-
 
9999
    FList.Count := FList.Count - 1;
-
 
10000
  end;
-
 
10001
end;
-
 
10002
 
-
 
10003
procedure TDXTextureImageFileBlockHeaderWriter.WriteBlock(BlockID: DWORD);
-
 
10004
var
-
 
10005
  BlockHeader: TDXTextureImageFileBlockHeader;
-
 
10006
begin
-
 
10007
  BlockHeader.ID := BlockID;
-
 
10008
  BlockHeader.Size := 0;
-
 
10009
  FStream.WriteBuffer(BlockHeader, SizeOf(BlockHeader));
-
 
10010
end;
-
 
10011
 
-
 
10012
procedure TDXTextureImageFileBlockHeaderWriter.StartGroup(CategoryType: DWORD);
-
 
10013
var
-
 
10014
  Header_StartGroup: TDXTextureImageFileBlockHeader_StartGroup;
-
 
10015
begin
-
 
10016
  StartBlock(DXTextureImageFileBlockID_StartGroup);
-
 
10017
 
-
 
10018
  Header_StartGroup.CategoryType := CategoryType;
-
 
10019
  FStream.WriteBuffer(Header_StartGroup, SizeOf(Header_StartGroup));
-
 
10020
end;
-
 
10021
 
-
 
10022
procedure TDXTextureImageFileBlockHeaderWriter.EndGroup;
-
 
10023
begin
-
 
10024
  WriteBlock(DXTextureImageFileBlockID_EndGroup);
-
 
10025
  EndBlock;
-
 
10026
end;
-
 
10027
 
-
 
10028
procedure DXTextureImage_SaveDXTextureImageFunc(Stream: TStream; Image: TDXTextureImage);
-
 
10029
var
-
 
10030
  Progress: Integer;
-
 
10031
  ProgressCount: Integer;
-
 
10032
  BlockHeaderWriter: TDXTextureImageFileBlockHeaderWriter;
-
 
10033
 
-
 
10034
  function CalcProgressCount(Image: TDXTextureImage): Integer;
-
 
10035
  var
-
 
10036
    i: Integer;
-
 
10037
  begin
-
 
10038
    Result := Image.WidthBytes * Image.Height;
-
 
10039
    for i := 0 to Image.SubImageCount - 1 do
-
 
10040
      Inc(Result, CalcProgressCount(Image.SubImages[i]));
-
 
10041
  end;
-
 
10042
 
-
 
10043
  procedure AddProgress(Count: Integer);
-
 
10044
  begin
-
 
10045
    Inc(Progress, Count);
-
 
10046
    Image.DoSaveProgress(Progress, ProgressCount);
-
 
10047
  end;
-
 
10048
 
-
 
10049
  procedure WriteGroup_Image(Image: TDXTextureImage);
-
 
10050
  var
-
 
10051
    i: Integer;
-
 
10052
    Header_Image_Format: TDXTextureImageHeader_Image_Format;
-
 
10053
    Header_Image_Format_Index: TDXTextureImageHeader_Image_Format_Index;
-
 
10054
    Header_Image_Format_RGB: TDXTextureImageHeader_Image_Format_RGB;
-
 
10055
    Header_Image_GroupInfo: TDXTextureImageHeader_Image_GroupInfo;
-
 
10056
    Header_Image_TransparentColor: TDXTextureImageHeader_Image_TransparentColor;
-
 
10057
    Header_Image_PixelData: TDXTextureImageHeader_Image_PixelData;
-
 
10058
  {$IFDEF DXTextureImage_UseZLIB}
-
 
10059
    Compression: TCompressionStream;
-
 
10060
  {$ENDIF}
-
 
10061
  begin
-
 
10062
    BlockHeaderWriter.StartGroup(DXTextureImageFileCategoryType_Image);
-
 
10063
    try
-
 
10064
      {  Image format writing  }
-
 
10065
      if Image.Size > 0 then
-
 
10066
      begin
-
 
10067
        Header_Image_Format.ImageType := Image.ImageType;
-
 
10068
        Header_Image_Format.Width := Image.Width;
-
 
10069
        Header_Image_Format.Height := Image.Height;
-
 
10070
        Header_Image_Format.BitCount := Image.BitCount;
-
 
10071
        Header_Image_Format.WidthBytes := Image.WidthBytes;
-
 
10072
 
-
 
10073
        BlockHeaderWriter.StartBlock(DXTextureImageFileBlockID_Image_Format);
-
 
10074
        try
-
 
10075
          Stream.WriteBuffer(Header_Image_Format, SizeOf(Header_Image_Format));
-
 
10076
 
-
 
10077
          case Image.ImageType of
-
 
10078
            DXTextureImageType_PaletteIndexedColor:
-
 
10079
              begin
-
 
10080
                {  INDEX IMAGE  }
-
 
10081
                Header_Image_Format_Index.idx_index_Mask := Image.idx_index.Mask;
-
 
10082
                Header_Image_Format_Index.idx_alpha_Mask := Image.idx_alpha.Mask;
-
 
10083
                for i := 0 to 255 do
-
 
10084
                  Header_Image_Format_Index.idx_palette[i] := Image.idx_palette[i];
-
 
10085
 
-
 
10086
                Stream.WriteBuffer(Header_Image_Format_Index, SizeOf(Header_Image_Format_Index));
-
 
10087
              end;
-
 
10088
            DXTextureImageType_RGBColor:
-
 
10089
              begin
-
 
10090
                {  RGB IMAGE  }
-
 
10091
                Header_Image_Format_RGB.rgb_red_Mask := Image.rgb_red.Mask;
-
 
10092
                Header_Image_Format_RGB.rgb_green_Mask := Image.rgb_green.Mask;
-
 
10093
                Header_Image_Format_RGB.rgb_blue_Mask := Image.rgb_blue.Mask;
-
 
10094
                Header_Image_Format_RGB.rgb_alpha_Mask := Image.rgb_alpha.Mask;
-
 
10095
 
-
 
10096
                Stream.WriteBuffer(Header_Image_Format_RGB, SizeOf(Header_Image_Format_RGB));
-
 
10097
              end;
-
 
10098
          end;
-
 
10099
        finally
-
 
10100
          BlockHeaderWriter.EndBlock;
-
 
10101
        end;
-
 
10102
      end;
-
 
10103
 
-
 
10104
      {  Image group information writing  }
-
 
10105
      BlockHeaderWriter.StartBlock(DXTextureImageFileBlockID_Image_GroupInfo);
-
 
10106
      try
-
 
10107
        Header_Image_GroupInfo.ImageGroupType := Image.ImageGroupType;
-
 
10108
        Header_Image_GroupInfo.ImageID := Image.ImageID;
-
 
10109
 
-
 
10110
        Stream.WriteBuffer(Header_Image_GroupInfo, SizeOf(Header_Image_GroupInfo));
-
 
10111
      finally
-
 
10112
        BlockHeaderWriter.EndBlock;
-
 
10113
      end;
-
 
10114
 
-
 
10115
      {  Name writing  }
-
 
10116
      BlockHeaderWriter.StartBlock(DXTextureImageFileBlockID_Image_Name);
-
 
10117
      try
-
 
10118
        Stream.WriteBuffer(Image.ImageName[1], Length(Image.ImageName));
-
 
10119
      finally
-
 
10120
        BlockHeaderWriter.EndBlock;
-
 
10121
      end;
-
 
10122
 
-
 
10123
      {  Transparent color writing  }
-
 
10124
      BlockHeaderWriter.StartBlock(DXTextureImageFileBlockID_Image_TransparentColor);
-
 
10125
      try
-
 
10126
        Header_Image_TransparentColor.Transparent := Image.Transparent;
-
 
10127
        Header_Image_TransparentColor.TransparentColor := Image.TransparentColor;
-
 
10128
 
-
 
10129
        Stream.WriteBuffer(Header_Image_TransparentColor, SizeOf(Header_Image_TransparentColor));
-
 
10130
      finally
-
 
10131
        BlockHeaderWriter.EndBlock;
-
 
10132
      end;
-
 
10133
 
-
 
10134
      {  Pixel data writing  }
-
 
10135
      if Image.Size > 0 then
-
 
10136
      begin
-
 
10137
        {  Writing start  }
-
 
10138
        BlockHeaderWriter.StartBlock(DXTextureImageFileBlockID_Image_PixelData);
-
 
10139
        try
-
 
10140
          {  Scan compress type  }
-
 
10141
          case Image.FileCompressType of
-
 
10142
            DXTextureImageFileCompressType_None:
-
 
10143
              begin
-
 
10144
                Header_Image_PixelData.Compress := DXTextureImageCompress_None;
-
 
10145
              end;
-
 
10146
            {$IFDEF DXTextureImage_UseZLIB}
-
 
10147
            DXTextureImageFileCompressType_ZLIB:
-
 
10148
              begin
-
 
10149
                Header_Image_PixelData.Compress := DXTextureImageCompress_ZLIB;
-
 
10150
              end;
-
 
10151
            {$ENDIF}
-
 
10152
          else
-
 
10153
            Header_Image_PixelData.Compress := DXTextureImageCompress_None;
-
 
10154
          end;
-
 
10155
 
-
 
10156
          Stream.WriteBuffer(Header_Image_PixelData, SizeOf(Header_Image_PixelData));
-
 
10157
 
-
 
10158
          case Header_Image_PixelData.Compress of
-
 
10159
            DXTextureImageCompress_None:
-
 
10160
              begin
-
 
10161
                for i := 0 to Image.Height - 1 do
-
 
10162
                begin
-
 
10163
                  Stream.WriteBuffer(Image.ScanLine[i]^, Image.Widthbytes);
-
 
10164
                  AddProgress(Image.Widthbytes);
-
 
10165
                end;
-
 
10166
              end;
-
 
10167
            {$IFDEF DXTextureImage_UseZLIB}
-
 
10168
            DXTextureImageCompress_ZLIB:
-
 
10169
              begin
-
 
10170
                Compression := TCompressionStream.Create(clMax, Stream);
-
 
10171
                try
-
 
10172
                  for i := 0 to Image.Height - 1 do
-
 
10173
                  begin
-
 
10174
                    Compression.WriteBuffer(Image.ScanLine[i]^, Image.WidthBytes);
-
 
10175
                    AddProgress(Image.Widthbytes);
-
 
10176
                  end;
-
 
10177
                finally
-
 
10178
                  Compression.Free;
-
 
10179
                end;
-
 
10180
              end;
-
 
10181
            {$ENDIF}
-
 
10182
          end;
-
 
10183
        finally
-
 
10184
          BlockHeaderWriter.EndBlock;
-
 
10185
        end;
-
 
10186
      end;
-
 
10187
 
-
 
10188
      {  Sub-image writing  }
-
 
10189
      for i := 0 to Image.SubImageCount - 1 do
-
 
10190
        WriteGroup_Image(Image.SubImages[i]);
-
 
10191
    finally
-
 
10192
      BlockHeaderWriter.EndGroup;
-
 
10193
    end;
-
 
10194
  end;
-
 
10195
 
-
 
10196
var
-
 
10197
  FileHeader: TDXTextureImageFileHeader;
-
 
10198
begin
-
 
10199
  Progress := 0;
-
 
10200
  ProgressCount := CalcProgressCount(Image);
-
 
10201
 
-
 
10202
  {  File header writing  }
-
 
10203
  FileHeader.FileType := DXTextureImageFile_Type;
-
 
10204
  FileHeader.ver := DXTextureImageFile_Version;
-
 
10205
  Stream.WriteBuffer(FileHeader, SizeOf(FileHeader));
-
 
10206
 
-
 
10207
  {  Image writing  }
-
 
10208
  BlockHeaderWriter := TDXTextureImageFileBlockHeaderWriter.Create(Stream);
-
 
10209
  try
-
 
10210
    {  Image writing  }
-
 
10211
    WriteGroup_Image(Image);
-
 
10212
 
-
 
10213
    {  End of file  }
-
 
10214
    BlockHeaderWriter.WriteBlock(DXTextureImageFileBlockID_EndFile);
-
 
10215
  finally
-
 
10216
    BlockHeaderWriter.Free;
-
 
10217
  end;
-
 
10218
end;
-
 
10219
 
-
 
10220
{  DXTextureImage_LoadBitmapFunc  }
-
 
10221
 
-
 
10222
procedure DXTextureImage_LoadBitmapFunc(Stream: TStream; Image: TDXTextureImage);
-
 
10223
type
-
 
10224
  TDIBPixelFormat = packed record
-
 
10225
    RBitMask, GBitMask, BBitMask: DWORD;
-
 
10226
  end;
-
 
10227
var
-
 
10228
  TopDown: Boolean;
-
 
10229
  BF: TBitmapFileHeader;
-
 
10230
  BI: TBitmapInfoHeader;
-
 
10231
 
-
 
10232
  procedure DecodeRGB;
-
 
10233
  var
-
 
10234
    y: Integer;
-
 
10235
  begin
-
 
10236
    for y := 0 to Image.Height - 1 do
-
 
10237
    begin
-
 
10238
      if TopDown then
-
 
10239
        Stream.ReadBuffer(Image.ScanLine[y]^, Image.WidthBytes)
-
 
10240
      else
-
 
10241
        Stream.ReadBuffer(Image.ScanLine[Image.Height - y - 1]^, Image.WidthBytes);
-
 
10242
    end;
-
 
10243
  end;
-
 
10244
 
-
 
10245
  procedure DecodeRLE4;
-
 
10246
  var
-
 
10247
    SrcDataP: Pointer;
-
 
10248
    B1, B2, C: Byte;
-
 
10249
    Dest, Src, P: PByte;
-
 
10250
    X, Y, i: Integer;
-
 
10251
  begin
-
 
10252
    GetMem(SrcDataP, BI.biSizeImage);
-
 
10253
    try
-
 
10254
      Stream.ReadBuffer(SrcDataP^, BI.biSizeImage);
-
 
10255
 
-
 
10256
      Dest := Image.TopPBits;
-
 
10257
      Src := SrcDataP;
-
 
10258
      X := 0;
-
 
10259
      Y := 0;
-
 
10260
 
-
 
10261
      while True do
-
 
10262
      begin
-
 
10263
        B1 := Src^; Inc(Src);
-
 
10264
        B2 := Src^; Inc(Src);
-
 
10265
 
-
 
10266
        if B1 = 0 then
-
 
10267
        begin
-
 
10268
          case B2 of
-
 
10269
            0: begin {  End of line  }
-
 
10270
                X := 0; Inc(Y);
-
 
10271
                Dest := Image.ScanLine[Y];
-
 
10272
              end;
-
 
10273
            1: Break; {  End of bitmap  }
-
 
10274
            2: begin {  Difference of coordinates  }
-
 
10275
                Inc(X, B1); Inc(Y, B2); Inc(Src, 2);
-
 
10276
                Dest := Image.ScanLine[Y];
-
 
10277
              end;
-
 
10278
          else
-
 
10279
            {  Absolute mode  }
-
 
10280
            C := 0;
-
 
10281
            for i := 0 to B2 - 1 do
-
 
10282
            begin
-
 
10283
              if i and 1 = 0 then
-
 
10284
              begin
-
 
10285
                C := Src^; Inc(Src);
-
 
10286
              end
-
 
10287
              else
-
 
10288
              begin
-
 
10289
                C := C shl 4;
-
 
10290
              end;
-
 
10291
 
-
 
10292
              P := Pointer(Integer(Dest) + X shr 1);
-
 
10293
              if X and 1 = 0 then
-
 
10294
                P^ := (P^ and $0F) or (C and $F0)
-
 
10295
              else
-
 
10296
                P^ := (P^ and $F0) or ((C and $F0) shr 4);
-
 
10297
 
-
 
10298
              Inc(X);
-
 
10299
            end;
-
 
10300
          end;
-
 
10301
        end
-
 
10302
        else
-
 
10303
        begin
-
 
10304
          {  Encoding mode  }
-
 
10305
          for i := 0 to B1 - 1 do
-
 
10306
          begin
-
 
10307
            P := Pointer(Integer(Dest) + X shr 1);
-
 
10308
            if X and 1 = 0 then
-
 
10309
              P^ := (P^ and $0F) or (B2 and $F0)
-
 
10310
            else
-
 
10311
              P^ := (P^ and $F0) or ((B2 and $F0) shr 4);
-
 
10312
 
-
 
10313
            Inc(X);
-
 
10314
 
-
 
10315
            // Swap nibble
-
 
10316
            B2 := (B2 shr 4) or (B2 shl 4);
-
 
10317
          end;
-
 
10318
        end;
-
 
10319
 
-
 
10320
        {  Word arrangement  }
-
 
10321
        Inc(Src, Longint(Src) and 1);
-
 
10322
      end;
-
 
10323
    finally
-
 
10324
      FreeMem(SrcDataP);
-
 
10325
    end;
-
 
10326
  end;
-
 
10327
 
-
 
10328
  procedure DecodeRLE8;
-
 
10329
  var
-
 
10330
    SrcDataP: Pointer;
-
 
10331
    B1, B2: Byte;
-
 
10332
    Dest, Src: PByte;
-
 
10333
    X, Y: Integer;
-
 
10334
  begin
-
 
10335
    GetMem(SrcDataP, BI.biSizeImage);
-
 
10336
    try
-
 
10337
      Stream.ReadBuffer(SrcDataP^, BI.biSizeImage);
-
 
10338
 
-
 
10339
      Dest := Image.TopPBits;
-
 
10340
      Src := SrcDataP;
-
 
10341
      X := 0;
-
 
10342
      Y := 0;
-
 
10343
 
-
 
10344
      while True do
-
 
10345
      begin
-
 
10346
        B1 := Src^; Inc(Src);
-
 
10347
        B2 := Src^; Inc(Src);
-
 
10348
 
-
 
10349
        if B1 = 0 then
-
 
10350
        begin
-
 
10351
          case B2 of
-
 
10352
            0: begin {  End of line  }
-
 
10353
                X := 0; Inc(Y);
-
 
10354
                Dest := Pointer(Longint(Image.TopPBits) + Y * Image.NextLine + X);
-
 
10355
              end;
-
 
10356
            1: Break; {  End of bitmap  }
-
 
10357
            2: begin {  Difference of coordinates  }
-
 
10358
                Inc(X, B1); Inc(Y, B2); Inc(Src, 2);
-
 
10359
                Dest := Pointer(Longint(Image.TopPBits) + Y * Image.NextLine + X);
-
 
10360
              end;
-
 
10361
          else
-
 
10362
            {  Absolute mode  }
-
 
10363
            Move(Src^, Dest^, B2); Inc(Dest, B2); Inc(Src, B2);
-
 
10364
          end;
-
 
10365
        end
-
 
10366
        else
-
 
10367
        begin
-
 
10368
          {  Encoding mode  }
-
 
10369
          FillChar(Dest^, B1, B2); Inc(Dest, B1);
-
 
10370
        end;
-
 
10371
 
-
 
10372
        {  Word arrangement  }
-
 
10373
        Inc(Src, Longint(Src) and 1);
-
 
10374
      end;
-
 
10375
    finally
-
 
10376
      FreeMem(SrcDataP);
-
 
10377
    end;
-
 
10378
  end;
-
 
10379
 
-
 
10380
var
-
 
10381
  BC: TBitmapCoreHeader;
-
 
10382
  RGBTriples: array[0..255] of TRGBTriple;
-
 
10383
  RGBQuads: array[0..255] of TRGBQuad;
-
 
10384
  i, PalCount, j: Integer;
-
 
10385
  OS2: Boolean;
-
 
10386
  PixelFormat: TDIBPixelFormat;
-
 
10387
begin
-
 
10388
  {  File header reading  }
-
 
10389
  i := Stream.Read(BF, SizeOf(TBitmapFileHeader));
-
 
10390
  if i = 0 then Exit;
-
 
10391
  if i <> SizeOf(TBitmapFileHeader) then
-
 
10392
    raise EDXTextureImageError.Create(SInvalidDIB);
-
 
10393
 
-
 
10394
  {  Is the head 'BM'?  }
-
 
10395
  if BF.bfType <> Ord('B') + Ord('M') * $100 then
-
 
10396
    raise EDXTextureImageError.Create(SInvalidDIB);
-
 
10397
 
-
 
10398
  {  Reading of size of header  }
-
 
10399
  i := Stream.Read(BI.biSize, 4);
-
 
10400
  if i <> 4 then
-
 
10401
    raise EDXTextureImageError.Create(SInvalidDIB);
-
 
10402
 
-
 
10403
  {  Kind check of DIB  }
-
 
10404
  OS2 := False;
-
 
10405
 
-
 
10406
  case BI.biSize of
-
 
10407
    SizeOf(TBitmapCoreHeader):
-
 
10408
      begin
-
 
10409
        {  OS/2 type  }
-
 
10410
        Stream.ReadBuffer(Pointer(Integer(@BC) + 4)^, SizeOf(TBitmapCoreHeader) - 4);
-
 
10411
 
-
 
10412
        FilLChar(BI, SizeOf(BI), 0);
-
 
10413
        with BI do
-
 
10414
        begin
-
 
10415
          biClrUsed := 0;
-
 
10416
          biCompression := BI_RGB;
-
 
10417
          biBitCount := BC.bcBitCount;
-
 
10418
          biHeight := BC.bcHeight;
-
 
10419
          biWidth := BC.bcWidth;
-
 
10420
        end;
-
 
10421
 
-
 
10422
        OS2 := True;
-
 
10423
      end;
-
 
10424
    SizeOf(TBitmapInfoHeader):
-
 
10425
      begin
-
 
10426
        {  Windows type  }
-
 
10427
        Stream.ReadBuffer(Pointer(Integer(@BI) + 4)^, SizeOf(TBitmapInfoHeader) - 4);
-
 
10428
      end;
-
 
10429
  else
-
 
10430
    raise EDXTextureImageError.Create(SInvalidDIB);
-
 
10431
  end;
-
 
10432
 
-
 
10433
  {  Bit mask reading  }
-
 
10434
  if BI.biCompression = BI_BITFIELDS then
-
 
10435
  begin
-
 
10436
    Stream.ReadBuffer(PixelFormat, SizeOf(PixelFormat));
-
 
10437
  end
-
 
10438
  else
-
 
10439
  begin
-
 
10440
    if BI.biBitCount = 16 then
-
 
10441
    begin
-
 
10442
      PixelFormat.RBitMask := $7C00;
-
 
10443
      PixelFormat.GBitMask := $03E0;
-
 
10444
      PixelFormat.BBitMask := $001F;
-
 
10445
    end else if (BI.biBitCount = 24) or (BI.biBitCount = 32) then
-
 
10446
    begin
-
 
10447
      PixelFormat.RBitMask := $00FF0000;
-
 
10448
      PixelFormat.GBitMask := $0300FF00;
-
 
10449
      PixelFormat.BBitMask := $000000FF;
-
 
10450
    end;
-
 
10451
  end;
-
 
10452
 
-
 
10453
  {  DIB making  }
-
 
10454
  if BI.biHeight < 0 then
-
 
10455
  begin
-
 
10456
    BI.biHeight := -BI.biHeight;
-
 
10457
    TopDown := True;
-
 
10458
  end
-
 
10459
  else
-
 
10460
    TopDown := False;
-
 
10461
 
-
 
10462
  if BI.biBitCount in [1, 4, 8] then
-
 
10463
  begin
-
 
10464
    Image.SetSize(DXTextureImageType_PaletteIndexedColor, BI.biWidth, BI.biHeight, BI.biBitCount,
-
 
10465
      (((BI.biWidth * BI.biBitCount) + 31) div 32) * 4);
-
 
10466
 
-
 
10467
    Image.idx_index := dxtMakeChannel(1 shl BI.biBitCount - 1, True);
-
 
10468
    Image.PackedPixelOrder := True;
-
 
10469
  end
-
 
10470
  else
-
 
10471
  begin
-
 
10472
    Image.SetSize(DXTextureImageType_RGBColor, BI.biWidth, BI.biHeight, BI.biBitCount,
-
 
10473
      (((BI.biWidth * BI.biBitCount) + 31) div 32) * 4);
-
 
10474
 
-
 
10475
    Image.rgb_red := dxtMakeChannel(PixelFormat.RBitMask, False);
-
 
10476
    Image.rgb_green := dxtMakeChannel(PixelFormat.GBitMask, False);
-
 
10477
    Image.rgb_blue := dxtMakeChannel(PixelFormat.BBitMask, False);
-
 
10478
 
-
 
10479
    j := Image.rgb_red.BitCount + Image.rgb_green.BitCount + Image.rgb_blue.BitCount;
-
 
10480
    if j < BI.biBitCount then
-
 
10481
      Image.rgb_alpha := dxtMakeChannel((1 shl (BI.biBitCount - j) - 1) shl j, False);
-
 
10482
 
-
 
10483
    Image.PackedPixelOrder := False;
-
 
10484
  end;
-
 
10485
 
-
 
10486
  {  palette reading  }
-
 
10487
  PalCount := BI.biClrUsed;
-
 
10488
  if (PalCount = 0) and (BI.biBitCount <= 8) then
-
 
10489
    PalCount := 1 shl BI.biBitCount;
-
 
10490
  if PalCount > 256 then PalCount := 256;
-
 
10491
 
-
 
10492
  if OS2 then
-
 
10493
  begin
-
 
10494
    {  OS/2 type  }
-
 
10495
    Stream.ReadBuffer(RGBTriples, SizeOf(TRGBTriple) * PalCount);
-
 
10496
    for i := 0 to PalCount - 1 do
-
 
10497
    begin
-
 
10498
      Image.idx_palette[i].peRed := RGBTriples[i].rgbtRed;
-
 
10499
      Image.idx_palette[i].peGreen := RGBTriples[i].rgbtGreen;
-
 
10500
      Image.idx_palette[i].peBlue := RGBTriples[i].rgbtBlue;
-
 
10501
    end;
-
 
10502
  end
-
 
10503
  else
-
 
10504
  begin
-
 
10505
    {  Windows type  }
-
 
10506
    Stream.ReadBuffer(RGBQuads, SizeOf(TRGBQuad) * PalCount);
-
 
10507
    for i := 0 to PalCount - 1 do
-
 
10508
    begin
-
 
10509
      Image.idx_palette[i].peRed := RGBQuads[i].rgbRed;
-
 
10510
      Image.idx_palette[i].peGreen := RGBQuads[i].rgbGreen;
-
 
10511
      Image.idx_palette[i].peBlue := RGBQuads[i].rgbBlue;
-
 
10512
    end;
-
 
10513
  end;
-
 
10514
 
-
 
10515
  {  Pixel data reading  }
-
 
10516
  case BI.biCompression of
-
 
10517
    BI_RGB: DecodeRGB;
-
 
10518
    BI_BITFIELDS: DecodeRGB;
-
 
10519
    BI_RLE4: DecodeRLE4;
-
 
10520
    BI_RLE8: DecodeRLE8;
-
 
10521
  else
-
 
10522
    raise EDXTextureImageError.Create(SInvalidDIB);
-
 
10523
  end;
-
 
10524
end;
-
 
10525
 
-
 
10526
{ TDXTBase }
-
 
10527
 
-
 
10528
//Note by JB.
-
 
10529
//This class is supplement of original Hori's code.
-
 
10530
//For use alphablend you can have a bitmap 32 bit RGBA
-
 
10531
//when isn't alphachannel present, it works like RGB 24bit
-
 
10532
 
-
 
10533
//functions required actualized DIB source for works with alphachannel
-
 
10534
 
-
 
10535
function TDXTBase.GetCompression: TDXTextureImageFileCompressType;
-
 
10536
begin
-
 
10537
  Result := FParamsFormat.Compress;
-
 
10538
end;
-
 
10539
 
-
 
10540
procedure TDXTBase.SetCompression(const Value: TDXTextureImageFileCompressType);
-
 
10541
begin
-
 
10542
  FParamsFormat.Compress := Value;
-
 
10543
end;
-
 
10544
 
-
 
10545
function TDXTBase.GetWidth: Integer;
-
 
10546
begin
-
 
10547
  Result := FParamsFormat.Width;
-
 
10548
end;
-
 
10549
 
-
 
10550
procedure TDXTBase.SetWidth(const Value: Integer);
-
 
10551
begin
-
 
10552
  FParamsFormat.Width := Value;
-
 
10553
end;
-
 
10554
 
-
 
10555
function TDXTBase.GetMipmap: Integer;
-
 
10556
begin
-
 
10557
  Result := FParamsFormat.MipmapCount;
-
 
10558
end;
-
 
10559
 
-
 
10560
procedure TDXTBase.SetMipmap(const Value: Integer);
-
 
10561
begin
-
 
10562
  if Value = -1 then
-
 
10563
    FParamsFormat.MipmapCount := MaxInt
-
 
10564
  else
-
 
10565
    FParamsFormat.MipmapCount := Value;
-
 
10566
end;
-
 
10567
 
-
 
10568
function TDXTBase.GetTransparentColor: TColorRef;
-
 
10569
begin
-
 
10570
  Result := FParamsFormat.TransparentColor;
-
 
10571
end;
-
 
10572
 
-
 
10573
procedure TDXTBase.SetTransparentColor(const Value: TColorRef);
-
 
10574
begin
-
 
10575
  FParamsFormat.Transparent := True;
-
 
10576
  FParamsFormat.TransparentColor := RGB(Value shr 16, Value shr 8, Value);
-
 
10577
end;
-
 
10578
 
-
 
10579
procedure TDXTBase.SetTransparentColorIndexed(const Value: TColorRef);
-
 
10580
begin
-
 
10581
  FParamsFormat.TransparentColor := PaletteIndex(Value);
-
 
10582
end;
-
 
10583
 
-
 
10584
function TDXTBase.GetHeight: Integer;
-
 
10585
begin
-
 
10586
  Result := FParamsFormat.Height;
-
 
10587
end;
-
 
10588
 
-
 
10589
procedure TDXTBase.SetHeight(const Value: Integer);
-
 
10590
begin
-
 
10591
  FParamsFormat.Height := Value;
-
 
10592
end;
-
 
10593
 
-
 
10594
procedure TDXTBase.SetChannelY(T: TDIB);
-
 
10595
begin
-
 
10596
 
-
 
10597
end;
-
 
10598
 
-
 
10599
procedure TDXTBase.LoadChannelRGBFromFile(const FileName: string);
-
 
10600
begin
-
 
10601
  FStrImageFileName := FileName;
-
 
10602
  try
-
 
10603
    EvaluateChannels([rgbRed, rgbGreen, rgbBlue], '', '');
-
 
10604
  finally
-
 
10605
    FStrImageFileName := '';
-
 
10606
  end;
-
 
10607
end;
-
 
10608
 
-
 
10609
function TDXTBase.LoadFromFile(iFilename: string): Boolean;
-
 
10610
begin
-
 
10611
  Result := FileExists(iFilename);
-
 
10612
  if Result then
-
 
10613
  try
-
 
10614
    Texture.LoadFromFile(iFileName);
-
 
10615
  except
-
 
10616
    Result := False;
-
 
10617
  end;
-
 
10618
end;
-
 
10619
 
-
 
10620
procedure TDXTBase.LoadChannelAFromFile(const FileName: string);
-
 
10621
begin
-
 
10622
  FStrImageFileName := FileName;
-
 
10623
  try
-
 
10624
    EvaluateChannels([rgbAlpha], '', '');
-
 
10625
  finally
-
 
10626
    FStrImageFileName := '';
-
 
10627
  end;
-
 
10628
end;
-
 
10629
 
-
 
10630
constructor TDXTBase.Create;
-
 
10631
var
-
 
10632
  Channel: TDXTImageChannel;
-
 
10633
begin
-
 
10634
  FillChar(Channel, SizeOf(Channel), 0);
-
 
10635
  FilLChar(FParamsFormat, SizeOf(FParamsFormat), 0);
-
 
10636
  FParamsFormat.Compress := DXTextureImageFileCompressType_None;
-
 
10637
  FHasImageList := TList.Create;
-
 
10638
  for Channel := Low(Channel) to High(Channel) do
-
 
10639
    FChannelChangeTable[Channel] := Channel;
-
 
10640
  FChannelChangeTable[rgbAlpha] := yuvY;
-
 
10641
  FDIB := nil;
-
 
10642
  FStrImageFileName := '';
-
 
10643
end;
-
 
10644
 
-
 
10645
procedure TDXTBase.SetChannelRGBA(T: TDIB);
-
 
10646
begin
-
 
10647
  FDIB := T;
-
 
10648
  try
-
 
10649
    EvaluateChannels([rgbRed, rgbGreen, rgbBlue, rgbAlpha], '', '');
-
 
10650
  finally
-
 
10651
    FDIB := nil;
-
 
10652
  end;
-
 
10653
end;
-
 
10654
 
-
 
10655
procedure TDXTBase.BuildImage(Image: TDXTextureImage);
-
 
10656
type
-
 
10657
  TOutputImageChannelInfo2 = record
-
 
10658
    Image: TDXTextureImage;
-
 
10659
    Channels: TDXTImageChannels;
-
 
10660
  end;
-
 
10661
var
-
 
10662
  cR, cG, cB: Byte;
-
 
10663
 
-
 
10664
  function GetChannelVal(const Channel: TDXTextureImageChannel; SrcChannel: TDXTImageChannel): DWORD;
-
 
10665
  begin
-
 
10666
    case SrcChannel of
-
 
10667
      rgbRed: Result := dxtEncodeChannel(Channel, cR);
-
 
10668
      rgbGreen: Result := dxtEncodeChannel(Channel, cG);
-
 
10669
      rgbBlue: Result := dxtEncodeChannel(Channel, cB);
-
 
10670
      yuvY: Result := dxtEncodeChannel(Channel, (cR * 306 + cG * 602 + cB * 116) div 1024);
-
 
10671
    else Result := 0;
-
 
10672
    end;
-
 
10673
  end;
-
 
10674
 
-
 
10675
var
-
 
10676
  HasImageChannelList: array[0..Ord(High(TDXTImageChannel)) + 1] of TOutputImageChannelInfo2;
-
 
10677
  HasImageChannelListCount: Integer;
-
 
10678
  x, y, i: Integer;
-
 
10679
  c, c2, c3: DWORD;
-
 
10680
  Channel: TDXTImageChannel;
-
 
10681
  Flag: Boolean;
-
 
10682
 
-
 
10683
  SrcImage: TDXTextureImage;
-
 
10684
  UseChannels: TDXTImageChannels;
-
 
10685
begin
-
 
10686
  HasImageChannelListCount := 0;
-
 
10687
  for Channel := Low(Channel) to High(Channel) do
-
 
10688
    if Channel in FHasChannels then
-
 
10689
    begin
-
 
10690
      Flag := False;
-
 
10691
      for i := 0 to HasImageChannelListCount - 1 do
-
 
10692
        if HasImageChannelList[i].Image = FHasChannelImages[Channel].Image then
-
 
10693
        begin
-
 
10694
          HasImageChannelList[i].Channels := HasImageChannelList[i].Channels + [Channel];
-
 
10695
          Flag := True;
-
 
10696
          Break;
-
 
10697
        end;
-
 
10698
      if not Flag then
-
 
10699
      begin
-
 
10700
        HasImageChannelList[HasImageChannelListCount].Image := FHasChannelImages[Channel].Image;
-
 
10701
        HasImageChannelList[HasImageChannelListCount].Channels := [Channel];
-
 
10702
        Inc(HasImageChannelListCount);
-
 
10703
      end;
-
 
10704
    end;
-
 
10705
 
-
 
10706
  cR := 0;
-
 
10707
  cG := 0;
-
 
10708
  cB := 0;
-
 
10709
 
-
 
10710
  if Image.ImageType = DXTextureImageType_PaletteIndexedColor then
-
 
10711
  begin
-
 
10712
    {  Index color  }
-
 
10713
    for y := 0 to Image.Height - 1 do
-
 
10714
      for x := 0 to Image.Width - 1 do
-
 
10715
      begin
-
 
10716
        c := 0;
-
 
10717
 
-
 
10718
        for i := 0 to HasImageChannelListCount - 1 do
-
 
10719
        begin
-
 
10720
          SrcImage := HasImageChannelList[i].Image;
-
 
10721
          UseChannels := HasImageChannelList[i].Channels;
-
 
10722
 
-
 
10723
          case SrcImage.ImageType of
-
 
10724
            DXTextureImageType_PaletteIndexedColor:
-
 
10725
              begin
-
 
10726
                c2 := SrcImage.Pixels[x, y];
-
 
10727
                c3 := dxtDecodeChannel(SrcImage.idx_index, c2);
-
 
10728
 
-
 
10729
                if rgbRed in UseChannels then
-
 
10730
                  c := c or dxtEncodeChannel(Image.idx_index, c3);
-
 
10731
 
-
 
10732
                cR := SrcImage.idx_palette[c3].peRed;
-
 
10733
                cG := SrcImage.idx_palette[c3].peGreen;
-
 
10734
                cB := SrcImage.idx_palette[c3].peBlue;
-
 
10735
              end;
-
 
10736
            DXTextureImageType_RGBColor:
-
 
10737
              begin
-
 
10738
                c2 := SrcImage.Pixels[x, y];
-
 
10739
 
-
 
10740
                cR := dxtDecodeChannel(SrcImage.rgb_red, c2);
-
 
10741
                cG := dxtDecodeChannel(SrcImage.rgb_green, c2);
-
 
10742
                cB := dxtDecodeChannel(SrcImage.rgb_blue, c2);
-
 
10743
              end;
-
 
10744
          end;
-
 
10745
 
-
 
10746
          if rgbAlpha in UseChannels then
-
 
10747
            c := c or GetChannelVal(Image.idx_alpha, FChannelChangeTable[rgbAlpha]);
-
 
10748
        end;
-
 
10749
 
-
 
10750
        Image.Pixels[x, y] := c;
-
 
10751
      end;
-
 
10752
  end
-
 
10753
  else
-
 
10754
    if Image.ImageType = DXTextureImageType_RGBColor then
-
 
10755
    begin
-
 
10756
    {  RGB color  }
-
 
10757
      for y := 0 to Image.Height - 1 do
-
 
10758
        for x := 0 to Image.Width - 1 do
-
 
10759
        begin
-
 
10760
          c := 0;
-
 
10761
 
-
 
10762
          for i := 0 to HasImageChannelListCount - 1 do
-
 
10763
          begin
-
 
10764
            SrcImage := HasImageChannelList[i].Image;
-
 
10765
            UseChannels := HasImageChannelList[i].Channels;
-
 
10766
 
-
 
10767
            case SrcImage.ImageType of
-
 
10768
              DXTextureImageType_PaletteIndexedColor:
-
 
10769
                begin
-
 
10770
                  c2 := SrcImage.Pixels[x, y];
-
 
10771
                  c3 := dxtDecodeChannel(SrcImage.idx_index, c2);
-
 
10772
 
-
 
10773
                  cR := SrcImage.idx_palette[c3].peRed;
-
 
10774
                  cG := SrcImage.idx_palette[c3].peGreen;
-
 
10775
                  cB := SrcImage.idx_palette[c3].peBlue;
-
 
10776
                end;
-
 
10777
              DXTextureImageType_RGBColor:
-
 
10778
                begin
-
 
10779
                  c2 := SrcImage.Pixels[x, y];
-
 
10780
 
-
 
10781
                  cR := dxtDecodeChannel(SrcImage.rgb_red, c2);
-
 
10782
                  cG := dxtDecodeChannel(SrcImage.rgb_green, c2);
-
 
10783
                  cB := dxtDecodeChannel(SrcImage.rgb_blue, c2);
-
 
10784
                end;
-
 
10785
            end;
-
 
10786
 
-
 
10787
            if rgbRed in UseChannels then
-
 
10788
              c := c or GetChannelVal(Image.rgb_red, FChannelChangeTable[rgbRed]);
-
 
10789
            if rgbGreen in UseChannels then
-
 
10790
              c := c or GetChannelVal(Image.rgb_green, FChannelChangeTable[rgbGreen]);
-
 
10791
            if rgbBlue in UseChannels then
-
 
10792
              c := c or GetChannelVal(Image.rgb_Blue, FChannelChangeTable[rgbBlue]);
-
 
10793
            if rgbAlpha in UseChannels then
-
 
10794
              c := c or GetChannelVal(Image.rgb_alpha, FChannelChangeTable[rgbAlpha]);
-
 
10795
          end;
-
 
10796
 
-
 
10797
          Image.Pixels[x, y] := c;
-
 
10798
        end;
-
 
10799
    end;
-
 
10800
end;
-
 
10801
 
-
 
10802
procedure TDXTBase.SetChannelR(T: TDIB);
-
 
10803
begin
-
 
10804
  FDIB := T;
-
 
10805
  try
-
 
10806
    EvaluateChannels([rgbRed], '', '');
-
 
10807
  finally
-
 
10808
    FDIB := nil;
-
 
10809
  end;
-
 
10810
end;
-
 
10811
 
-
 
10812
function GetBitCount(b: Integer): Integer;
-
 
10813
begin
-
 
10814
  Result := 32;
-
 
10815
  while (Result > 0) and (((1 shl (Result - 1)) and b) = 0) do Dec(Result);
-
 
10816
end;
-
 
10817
 
-
 
10818
procedure TDXTBase.CalcOutputBitFormat;
-
 
10819
var
-
 
10820
  BitCount: DWORD;
-
 
10821
  NewWidth, NewHeight, i, j: Integer;
-
 
10822
  Channel: TDXTImageChannel;
-
 
10823
begin
-
 
10824
  {  Size calculation  }
-
 
10825
  NewWidth := 1 shl GetBitCount(TDXTextureImage(FHasImageList[0]).Width);
-
 
10826
  NewHeight := 1 shl GetBitCount(TDXTextureImage(FHasImageList[0]).Height);
-
 
10827
  NewWidth := Max(NewWidth, NewHeight);
-
 
10828
  NewHeight := NewWidth;
-
 
10829
  if Abs(FParamsFormat.Width - NewWidth) > Abs(FParamsFormat.Width - NewWidth div 2) then
-
 
10830
    NewWidth := NewWidth div 2;
-
 
10831
  if Abs(FParamsFormat.Height - NewHeight) > Abs(FParamsFormat.Height - NewHeight div 2) then
-
 
10832
    NewHeight := NewHeight div 2;
-
 
10833
 
-
 
10834
  if FParamsFormat.Width = 0 then FParamsFormat.Width := NewWidth;
-
 
10835
  if FParamsFormat.Height = 0 then FParamsFormat.Height := NewHeight;
-
 
10836
 
-
 
10837
  {  Other several calculation  }
-
 
10838
  i := Min(FParamsFormat.Width, FParamsFormat.Height);
-
 
10839
  j := 0;
-
 
10840
  while i > 1 do
-
 
10841
  begin
-
 
10842
    i := i div 2;
-
 
10843
    Inc(j);
-
 
10844
  end;
-
 
10845
 
-
 
10846
  FParamsFormat.MipmapCount := Min(j, FParamsFormat.MipmapCount);
-
 
10847
 
-
 
10848
  {  Output type calculation  }
-
 
10849
  if (FHasChannelImages[rgbRed].Image = FHasChannelImages[rgbGreen].Image) and
-
 
10850
    (FHasChannelImages[rgbRed].Image = FHasChannelImages[rgbBlue].Image) and
-
 
10851
    (FHasChannelImages[rgbRed].Image <> nil) and
-
 
10852
    (FHasChannelImages[rgbRed].Image.ImageType = DXTextureImageType_PaletteIndexedColor) and
-
 
10853
 
-
 
10854
    (FHasChannelImages[rgbRed].BitCount = 8) and
-
 
10855
    (FHasChannelImages[rgbGreen].BitCount = 8) and
-
 
10856
    (FHasChannelImages[rgbBlue].BitCount = 8) and
-
 
10857
 
-
 
10858
    (FChannelChangeTable[rgbRed] = rgbRed) and
-
 
10859
    (FChannelChangeTable[rgbGreen] = rgbGreen) and
-
 
10860
    (FChannelChangeTable[rgbBlue] = rgbBlue) and
-
 
10861
 
-
 
10862
    (FParamsFormat.Width = FHasChannelImages[rgbRed].Image.Width) and
-
 
10863
    (FParamsFormat.Height = FHasChannelImages[rgbRed].Image.Height) and
-
 
10864
 
-
 
10865
    (FParamsFormat.MipmapCount = 0)
-
 
10866
  then
-
 
10867
  begin
-
 
10868
    FParamsFormat.ImageType := DXTextureImageType_PaletteIndexedColor;
-
 
10869
  end
-
 
10870
  else
-
 
10871
    FParamsFormat.ImageType := DXTextureImageType_RGBColor;
-
 
10872
 
-
 
10873
  {  Bit several calculations  }
-
 
10874
  FParamsFormat.BitCount := 0;
-
 
10875
 
-
 
10876
  for Channel := Low(TDXTImageChannel) to High(TDXTImageChannel) do
-
 
10877
    if (FHasChannelImages[Channel].Image <> nil) and (FHasChannelImages[Channel].Image.ImageType = DXTextureImageType_PaletteIndexedColor) then
-
 
10878
    begin
-
 
10879
      FParamsFormat.idx_palette := FHasChannelImages[Channel].Image.idx_palette;
-
 
10880
      Break;
-
 
10881
    end;
-
 
10882
 
-
 
10883
  if FParamsFormat.ImageType = DXTextureImageType_PaletteIndexedColor then
-
 
10884
  begin
-
 
10885
    {  Index channel }
-
 
10886
    if rgbRed in FHasChannels then
-
 
10887
    begin
-
 
10888
      BitCount := FHasChannelImages[rgbRed].BitCount;
-
 
10889
      FParamsFormat.idx_index := dxtMakeChannel(((1 shl BitCount) - 1) shl FParamsFormat.BitCount, True);
-
 
10890
      Inc(FParamsFormat.BitCount, BitCount);
-
 
10891
    end;
-
 
10892
 
-
 
10893
    {  Alpha channel  }
-
 
10894
    if rgbAlpha in FHasChannels then
-
 
10895
    begin
-
 
10896
      BitCount := FHasChannelImages[rgbAlpha].BitCount;
-
 
10897
      FParamsFormat.idx_alpha := dxtMakeChannel(((1 shl BitCount) - 1) shl FParamsFormat.BitCount, False);
-
 
10898
      Inc(FParamsFormat.BitCount, BitCount);
-
 
10899
    end;
-
 
10900
  end
-
 
10901
  else
-
 
10902
  begin
-
 
10903
    {  B channel }
-
 
10904
    if rgbBlue in FHasChannels then
-
 
10905
    begin
-
 
10906
      BitCount := FHasChannelImages[rgbBlue].BitCount;
-
 
10907
      FParamsFormat.rgb_blue := dxtMakeChannel(((1 shl BitCount) - 1) shl FParamsFormat.BitCount, False);
-
 
10908
      Inc(FParamsFormat.BitCount, BitCount);
-
 
10909
    end;
-
 
10910
 
-
 
10911
    {  G channel }
-
 
10912
    if rgbGreen in FHasChannels then
-
 
10913
    begin
-
 
10914
      BitCount := FHasChannelImages[rgbGreen].BitCount;
-
 
10915
      FParamsFormat.rgb_green := dxtMakeChannel(((1 shl BitCount) - 1) shl FParamsFormat.BitCount, False);
-
 
10916
      Inc(FParamsFormat.BitCount, BitCount);
-
 
10917
    end;
-
 
10918
 
-
 
10919
    {  R channel }
-
 
10920
    if rgbRed in FHasChannels then
-
 
10921
    begin
-
 
10922
      BitCount := FHasChannelImages[rgbRed].BitCount;
-
 
10923
      FParamsFormat.rgb_red := dxtMakeChannel(((1 shl BitCount) - 1) shl FParamsFormat.BitCount, False);
-
 
10924
      Inc(FParamsFormat.BitCount, BitCount);
-
 
10925
    end;
-
 
10926
 
-
 
10927
    {  Alpha channel }
-
 
10928
    if rgbAlpha in FHasChannels then
-
 
10929
    begin
-
 
10930
      BitCount := FHasChannelImages[rgbAlpha].BitCount;
-
 
10931
      FParamsFormat.rgb_alpha := dxtMakeChannel(((1 shl BitCount) - 1) shl FParamsFormat.BitCount, False);
-
 
10932
      Inc(FParamsFormat.BitCount, BitCount);
-
 
10933
    end;
-
 
10934
  end;
-
 
10935
 
-
 
10936
  {  As for the number of bits only either of 1, 2, 4, 8, 16, 24, 32  }
-
 
10937
  if FParamsFormat.BitCount in [3] then
-
 
10938
    FParamsFormat.BitCount := 4
-
 
10939
  else
-
 
10940
  if FParamsFormat.BitCount in [5..7] then
-
 
10941
    FParamsFormat.BitCount := 8
-
 
10942
  else
-
 
10943
  if FParamsFormat.BitCount in [9..15] then
-
 
10944
    FParamsFormat.BitCount := 16
-
 
10945
  else
-
 
10946
  if FParamsFormat.BitCount in [17..23] then
-
 
10947
    FParamsFormat.BitCount := 24
-
 
10948
  else
-
 
10949
  if FParamsFormat.BitCount in [25..31] then
-
 
10950
    FParamsFormat.BitCount := 32;
-
 
10951
 
-
 
10952
  {  Transparent color  }
-
 
10953
  if (FParamsFormat.ImageType = DXTextureImageType_RGBColor) and (FParamsFormat.TransparentColor shr 24 = $01) then
-
 
10954
  begin
-
 
10955
    FParamsFormat.TransparentColor := RGB(FParamsFormat.idx_palette[Byte(FParamsFormat.TransparentColor)].peRed,
-
 
10956
      FParamsFormat.idx_palette[Byte(FParamsFormat.TransparentColor)].peGreen,
-
 
10957
      FParamsFormat.idx_palette[Byte(FParamsFormat.TransparentColor)].peBlue);
-
 
10958
  end;
-
 
10959
end;
-
 
10960
 
-
 
10961
procedure TDXTBase.LoadChannelRGBAFromFile(const FileName: string);
-
 
10962
begin
-
 
10963
  FStrImageFileName := FileName;
-
 
10964
  try
-
 
10965
    EvaluateChannels([rgbRed, rgbGreen, rgbBlue, rgbAlpha], '', '');
-
 
10966
  finally
-
 
10967
    FStrImageFileName := '';
-
 
10968
  end;
-
 
10969
end;
-
 
10970
 
-
 
10971
procedure TDXTBase.SetChannelB(T: TDIB);
-
 
10972
begin
-
 
10973
  FDIB := T;
-
 
10974
  try
-
 
10975
    EvaluateChannels([rgbBlue], '', '');
-
 
10976
  finally
-
 
10977
    FDIB := nil;
-
 
10978
  end;
-
 
10979
end;
-
 
10980
 
-
 
10981
procedure TDXTBase.SetChannelRGB(T: TDIB);
-
 
10982
begin
-
 
10983
  FDIB := T;
-
 
10984
  try
-
 
10985
    EvaluateChannels([rgbRed, rgbGreen, rgbBlue], '', '');
-
 
10986
  finally
-
 
10987
    FDIB := nil;
-
 
10988
  end;
-
 
10989
end;
-
 
10990
 
-
 
10991
procedure TDXTBase.SaveToFile(iFilename: string {$IFDEF VER4UP} = ''{$ENDIF});
-
 
10992
var
-
 
10993
  Image: TDXTextureImage;
-
 
10994
begin
-
 
10995
  {  Create output stream  }
-
 
10996
  Image := Self.Texture;
-
 
10997
  if (FHasImageList.Count > 0) and Assigned(Image) then
-
 
10998
  begin
-
 
10999
    if iFilename <> '' then
-
 
11000
      Image.SaveToFile(iFilename)
-
 
11001
    else
-
 
11002
      Image.SaveToFile(FParamsFormat.Name + '.dxt');
-
 
11003
  end;
-
 
11004
end;
-
 
11005
 
-
 
11006
procedure TDXTBase.SetChannelA(T: TDIB);
-
 
11007
begin
-
 
11008
  FDIB := T;
-
 
11009
  try
-
 
11010
    EvaluateChannels([rgbAlpha], '', '');
-
 
11011
  finally
-
 
11012
    FDIB := nil;
-
 
11013
  end;
-
 
11014
end;
-
 
11015
 
-
 
11016
procedure TDXTBase.SetChannelG(T: TDIB);
-
 
11017
begin
-
 
11018
  FDIB := T;
-
 
11019
  try
-
 
11020
    EvaluateChannels([rgbGreen], '', '');
-
 
11021
  finally
-
 
11022
    FDIB := nil;
-
 
11023
  end;
-
 
11024
end;
-
 
11025
 
-
 
11026
destructor TDXTBase.Destroy;
-
 
11027
var I: Integer;
-
 
11028
begin
-
 
11029
  for I := 0 to FHasImageList.Count - 1 do
-
 
11030
    TDXTextureImage(FHasImageList[I]).Free;
-
 
11031
  FHasImageList.Free;
-
 
11032
  inherited Destroy;
-
 
11033
end;
-
 
11034
 
-
 
11035
function TDXTBase.GetPicture: TDXTextureImage;
-
 
11036
var
-
 
11037
  MemoryStream: TMemoryStream;
-
 
11038
begin
-
 
11039
  Result := TDXTextureImage.Create;
-
 
11040
  try
-
 
11041
    if (FStrImageFileName <> '') and FileExists(FStrImageFileName) then
-
 
11042
    begin
-
 
11043
      Result.LoadFromFile(FStrImageFileName);
-
 
11044
      Result.FImageName := ExtractFilename(FStrImageFileName);
-
 
11045
    end
-
 
11046
    else
-
 
11047
      if Assigned(FDIB) then
-
 
11048
      begin
-
 
11049
        MemoryStream := TMemoryStream.Create;
-
 
11050
        try
-
 
11051
          FDIB.SaveToStream(MemoryStream);
-
 
11052
          MemoryStream.Position := 0; //reading from 0
-
 
11053
          Result.LoadFromStream(MemoryStream);
-
 
11054
        finally
-
 
11055
          MemoryStream.Free;
-
 
11056
        end;
-
 
11057
        Result.FImageName := Format('DIB%x', [Integer(Result)]); //supplement name
-
 
11058
      end;
-
 
11059
  except
-
 
11060
    on E: Exception do
-
 
11061
    begin
-
 
11062
      EDXTBaseError.Create(E.Message);
-
 
11063
    end;
-
 
11064
  end
-
 
11065
end;
-
 
11066
 
-
 
11067
procedure TDXTBase.Resize(Image: TDXTextureImage; NewWidth, NewHeight: Integer;
-
 
11068
  FilterTypeResample: TFilterTypeResample);
-
 
11069
  //resize used for Mipmap
-
 
11070
var
-
 
11071
  DIB: TDIB;
-
 
11072
  x, y: Integer;
-
 
11073
  c: DWORD;
-
 
11074
  MemoryStream: TMemoryStream;
-
 
11075
begin
-
 
11076
  {  Exit when no resize  }
-
 
11077
  if (Image.Width = NewWidth) and (Image.Height = NewHeight) then Exit;
-
 
11078
  {  Supplement for image resizing  }
-
 
11079
  //raise EDXTBaseError.Create('Invalid image size for texture.');
-
 
11080
  {  No image at start  }
-
 
11081
  DIB := TDIB.Create; //DIB accept
-
 
11082
  try
-
 
11083
    DIB.SetSize(Image.Width, Image.Height, Image.BitCount);
-
 
11084
    {  of type  }
-
 
11085
    for y := 0 to Image.Height - 1 do
-
 
11086
      for x := 0 to Image.Width - 1 do
-
 
11087
      begin
-
 
11088
        if Image.ImageType = DXTextureImageType_PaletteIndexedColor then
-
 
11089
        begin
-
 
11090
          c := dxtDecodeChannel(Image.idx_index, Image.Pixels[x, y]);
-
 
11091
          DIB.Pixels[x, y] := (Image.idx_palette[c].peRed shl 16) or
-
 
11092
            (Image.idx_palette[c].peGreen shl 8) or
-
 
11093
            Image.idx_palette[c].peBlue;
-
 
11094
        end
-
 
11095
        else begin
-
 
11096
          c := Image.Pixels[x, y];
-
 
11097
          DIB.Pixels[x, y] := (dxtDecodeChannel(Image.rgb_red, c) shl 16) or
-
 
11098
            (dxtDecodeChannel(Image.rgb_green, c) shl 8) or
-
 
11099
            dxtDecodeChannel(Image.rgb_blue, c);
-
 
11100
        end;
-
 
11101
      end;
-
 
11102
 
-
 
11103
    {  Resize for 24 bitcount deep }
-
 
11104
    Image.SetSize(DXTextureImageType_RGBColor, Width, Height, Image.BitCount, 0);
-
 
11105
 
-
 
11106
    Image.rgb_red := dxtMakeChannel($FF0000, False);
-
 
11107
    Image.rgb_green := dxtMakeChannel($00FF00, False);
-
 
11108
    Image.rgb_blue := dxtMakeChannel($0000FF, False);
-
 
11109
    Image.rgb_alpha := dxtMakeChannel(0, False);
-
 
11110
 
-
 
11111
    {  Resample routine DIB based there  }
-
 
11112
    DIB.DoResample(Width, Height, FilterTypeResample);
-
 
11113
 
-
 
11114
    {Image returned through stream}
-
 
11115
    Image.ClearImage;
-
 
11116
    MemoryStream := TMemoryStream.Create;
-
 
11117
    try
-
 
11118
      DIB.SaveToStream(MemoryStream);
-
 
11119
      MemoryStream.Position := 0; //from first byte
-
 
11120
      Image.LoadFromStream(MemoryStream);
-
 
11121
    finally
-
 
11122
      MemoryStream.Free;
-
 
11123
    end;
-
 
11124
  finally
-
 
11125
    DIB.Free;
-
 
11126
  end;
-
 
11127
end;
-
 
11128
 
-
 
11129
procedure TDXTBase.EvaluateChannels
-
 
11130
  (const CheckChannelUsed: TDXTImageChannels;
-
 
11131
  const CheckChannelChanged, CheckBitCountForChannel: string);
-
 
11132
var J: Integer;
-
 
11133
  Channel: TDXTImageChannel;
-
 
11134
  ChannelBitCount: array[TDXTImageChannel] of Integer;
-
 
11135
  ChannelParamName: TDXTImageChannels;
-
 
11136
  Image: TDXTextureImage;
-
 
11137
  Q: TDXTImageChannel;
-
 
11138
begin
-
 
11139
  Fillchar(ChannelBitCount, SizeOf(ChannelBitCount), 0);
-
 
11140
  ChannelParamName := [];
-
 
11141
  {  The channel which you use acquisition  }
-
 
11142
  J := 0;
-
 
11143
  for Q := rgbRed to rgbAlpha do
-
 
11144
  begin
-
 
11145
    if Q in CheckChannelUsed then
-
 
11146
    begin
-
 
11147
      Inc(J);
-
 
11148
      Channel := Q;
-
 
11149
      if not (Channel in FHasChannels) then
-
 
11150
      begin
-
 
11151
        if CheckBitCountForChannel <> '' then
-
 
11152
          ChannelBitCount[Channel] := StrToInt(Copy(CheckBitCountForChannel, j, 1))
-
 
11153
        else
-
 
11154
          ChannelBitCount[Channel] := 8; {poke default value}
-
 
11155
        if ChannelBitCount[Channel] <> 0 then
-
 
11156
          ChannelParamName := ChannelParamName + [Channel];
-
 
11157
 
-
 
11158
        if CheckChannelChanged <> '' then
-
 
11159
        begin
-
 
11160
          case UpCase(CheckChannelChanged[j]) of
-
 
11161
            'R': FChannelChangeTable[Channel] := rgbRed;
-
 
11162
            'G': FChannelChangeTable[Channel] := rgbGreen;
-
 
11163
            'B': FChannelChangeTable[Channel] := rgbBlue;
-
 
11164
            'Y': FChannelChangeTable[Channel] := yuvY;
-
 
11165
            'N': FChannelChangeTable[Channel] := rgbNone;
-
 
11166
          else
-
 
11167
            raise EDXTBaseError.CreateFmt('Invalid channel type(%s)', [CheckChannelChanged[j]]);
-
 
11168
          end;
-
 
11169
        end;
-
 
11170
      end;
-
 
11171
    end;
-
 
11172
  end;
-
 
11173
  {  Processing of each  }
-
 
11174
  if ChannelParamName <> [] then
-
 
11175
  begin
-
 
11176
    {  Picture load  }
-
 
11177
    Image := nil;
-
 
11178
    {pokud je image uz nahrany tj. stejneho jmena, pokracuj dale}
-
 
11179
    for j := 0 to FHasImageList.Count - 1 do
-
 
11180
      if AnsiCompareFileName(TDXTextureImage(FHasImageList[j]).ImageName, FStrImageFileName) = 0 then
-
 
11181
      begin
-
 
11182
        Image := FHasImageList[j];
-
 
11183
        Break;
-
 
11184
      end;
-
 
11185
    {obrazek neexistuje, musi se dotahnout bud z proudu, souboru nebo odjinut}
-
 
11186
    if Image = nil then
-
 
11187
    begin
-
 
11188
      try
-
 
11189
        Image := GetPicture;
-
 
11190
      except
-
 
11191
        if Assigned(Image) then
-
 
11192
        begin
-
 
11193
          {$IFNDEF VER5UP}
-
 
11194
          Image.Free; Image := nil;
-
 
11195
          {$ELSE}
-
 
11196
          FreeAndNil(Image);
-
 
11197
          {$ENDIF}
-
 
11198
        end;
-
 
11199
        raise;
-
 
11200
      end;
-
 
11201
      FHasImageList.Add(Image);
-
 
11202
    end;
-
 
11203
 
-
 
11204
    {  Each channel processing  }
-
 
11205
    for Channel := Low(Channel) to High(Channel) do
-
 
11206
      if Channel in ChannelParamName then
-
 
11207
      begin
-
 
11208
        if ChannelBitCount[Channel] >= 0 then
-
 
11209
          FHasChannelImages[Channel].BitCount := ChannelBitCount[Channel]
-
 
11210
        else
-
 
11211
        begin
-
 
11212
          case Image.ImageType of
-
 
11213
            DXTextureImageType_PaletteIndexedColor:
-
 
11214
              begin
-
 
11215
                case Channel of
-
 
11216
                  rgbRed: FHasChannelImages[Channel].BitCount := 8;
-
 
11217
                  rgbGreen: FHasChannelImages[Channel].BitCount := 8;
-
 
11218
                  rgbBlue: FHasChannelImages[Channel].BitCount := 8;
-
 
11219
                  rgbAlpha: FHasChannelImages[Channel].BitCount := 8;
-
 
11220
                end;
-
 
11221
              end;
-
 
11222
            DXTextureImageType_RGBColor:
-
 
11223
              begin
-
 
11224
                case Channel of
-
 
11225
                  rgbRed: FHasChannelImages[Channel].BitCount := Image.rgb_red.BitCount;
-
 
11226
                  rgbGreen: FHasChannelImages[Channel].BitCount := Image.rgb_green.BitCount;
-
 
11227
                  rgbBlue: FHasChannelImages[Channel].BitCount := Image.rgb_blue.BitCount;
-
 
11228
                  rgbAlpha: FHasChannelImages[Channel].BitCount := 8;
-
 
11229
                end;
-
 
11230
              end;
-
 
11231
          end;
-
 
11232
        end;
-
 
11233
        if FHasChannelImages[Channel].BitCount = 0 then Continue;
-
 
11234
        FHasChannels := FHasChannels + [Channel];
-
 
11235
        FHasChannelImages[Channel].Image := Image;
-
 
11236
      end;
-
 
11237
  end;
-
 
11238
end;
-
 
11239
 
-
 
11240
function TDXTBase.GetTexture: TDXTextureImage;
-
 
11241
var
-
 
11242
  i, j: Integer;
-
 
11243
  SubImage: TDXTextureImage;
-
 
11244
  CurWidth, CurHeight: Integer;
-
 
11245
begin
-
 
11246
  Result := nil;
-
 
11247
  if FHasImageList.Count = 0 then
-
 
11248
    raise EDXTBaseError.Create('No image found');
-
 
11249
 
-
 
11250
  {  Output format calculation  }
-
 
11251
  CalcOutputBitFormat;
-
 
11252
  Result := TDXTextureImage.Create;
-
 
11253
  try
-
 
11254
    Result.SetSize(FParamsFormat.ImageType, FParamsFormat.Width, FParamsFormat.Height, FParamsFormat.BitCount, 0);
-
 
11255
 
-
 
11256
    Result.idx_index := FParamsFormat.idx_index;
-
 
11257
    Result.idx_alpha := FParamsFormat.idx_alpha;
-
 
11258
    Result.idx_palette := FParamsFormat.idx_palette;
-
 
11259
 
-
 
11260
    Result.rgb_red := FParamsFormat.rgb_red;
-
 
11261
    Result.rgb_green := FParamsFormat.rgb_green;
-
 
11262
    Result.rgb_blue := FParamsFormat.rgb_blue;
-
 
11263
    Result.rgb_alpha := FParamsFormat.rgb_alpha;
-
 
11264
 
-
 
11265
    Result.ImageName := FParamsFormat.Name;
-
 
11266
 
-
 
11267
    Result.Transparent := FParamsFormat.Transparent;
-
 
11268
    if FParamsFormat.TransparentColor shr 24 = $01 then
-
 
11269
      Result.TransparentColor := dxtEncodeChannel(Result.idx_index, PaletteIndex(Byte(FParamsFormat.TransparentColor)))
-
 
11270
    else
-
 
11271
      Result.TransparentColor := Result.EncodeColor(GetRValue(FParamsFormat.TransparentColor), GetGValue(FParamsFormat.TransparentColor), GetBValue(FParamsFormat.TransparentColor), 0);
-
 
11272
 
-
 
11273
    BuildImage(Result);
-
 
11274
 
-
 
11275
    if FParamsFormat.ImageType = DXTextureImageType_RGBColor then
-
 
11276
    begin
-
 
11277
      BuildImage(Result);
-
 
11278
      {  Picture information store here  }
-
 
11279
      CurWidth := FParamsFormat.Width;
-
 
11280
      CurHeight := FParamsFormat.Height;
-
 
11281
      for i := 0 to FParamsFormat.MipmapCount - 1 do
-
 
11282
      begin
-
 
11283
        CurWidth := CurWidth div 2;
-
 
11284
        CurHeight := CurHeight div 2;
-
 
11285
        if (CurWidth <= 0) or (CurHeight <= 0) then Break;
-
 
11286
        {  Resize calc here }
-
 
11287
        for j := 0 to FHasImageList.Count - 1 do
-
 
11288
          Resize(FHasImageList[j], CurWidth, CurHeight, ftrTriangle);
-
 
11289
 
-
 
11290
        SubImage := TDXTextureImage.CreateSub(Result);
-
 
11291
        SubImage.SetSize(FParamsFormat.ImageType, CurWidth, CurHeight, FParamsFormat.BitCount, 0);
-
 
11292
 
-
 
11293
        SubImage.idx_index := FParamsFormat.idx_index;
-
 
11294
        SubImage.idx_alpha := FParamsFormat.idx_alpha;
-
 
11295
        SubImage.idx_palette := FParamsFormat.idx_palette;
-
 
11296
 
-
 
11297
        SubImage.rgb_red := FParamsFormat.rgb_red;
-
 
11298
        SubImage.rgb_green := FParamsFormat.rgb_green;
-
 
11299
        SubImage.rgb_blue := FParamsFormat.rgb_blue;
-
 
11300
        SubImage.rgb_alpha := FParamsFormat.rgb_alpha;
-
 
11301
 
-
 
11302
        SubImage.ImageGroupType := DXTextureImageGroupType_Normal;
-
 
11303
        SubImage.ImageID := i;
-
 
11304
        SubImage.ImageName := Format('%s - mimap #%d', [Result.ImageName, i + 1]);
-
 
11305
 
-
 
11306
        BuildImage(SubImage);
-
 
11307
      end;
-
 
11308
    end;
-
 
11309
    Result.FileCompressType := FParamsFormat.Compress;
-
 
11310
  except
-
 
11311
    on E: Exception do
-
 
11312
    begin
-
 
11313
      {$IFNDEF VER5UP}
-
 
11314
      Result.Free;
-
 
11315
      Result := nil;
-
 
11316
      {$ELSE}
-
 
11317
      FreeAndNil(Result);
-
 
11318
      {$ENDIF}
-
 
11319
      raise EDXTBaseError.Create(E.Message);
-
 
11320
    end;
-
 
11321
  end;
-
 
11322
end;
-
 
11323
 
-
 
11324
{ DIB2DTX }
-
 
11325
 
-
 
11326
procedure dib2dxt(DIBImage: TDIB; out DXTImage: TDXTextureImage{$IFDEF DXTextureImage_UseZLIB}; const Shrink: Boolean = True{$ENDIF});
-
 
11327
var
-
 
11328
  TexImage: TDXTBase;
-
 
11329
  DIB: TDIB;
-
 
11330
begin
-
 
11331
  TexImage := TDXTBase.Create;
-
 
11332
  try
-
 
11333
    {$IFDEF DXTextureImage_UseZLIB}
-
 
11334
    if Shrink then
-
 
11335
    begin
-
 
11336
      TexImage.Compression := DXTextureImageFileCompressType_ZLIB;
-
 
11337
      TexImage.Mipmap := 4;
-
 
11338
    end;
-
 
11339
    {$ENDIF}
-
 
11340
    try
-
 
11341
      if DIBImage.HasAlphaChannel then
-
 
11342
      begin
-
 
11343
        DIB := DIBImage.RGBChannel;
-
 
11344
        TexImage.SetChannelRGB(DIB);
-
 
11345
        DIB.Free;
-
 
11346
        DIB := DIBImage.AlphaChannel;
-
 
11347
        TexImage.SetChannelA(DIB);
-
 
11348
        DIB.Free;
-
 
11349
      end
-
 
11350
      else
-
 
11351
        TexImage.SetChannelRGB(DIBImage);
-
 
11352
 
-
 
11353
      DXTImage := TexImage.Texture;
-
 
11354
    except
-
 
11355
      if Assigned(DXTImage) then
-
 
11356
        DXTImage.Free;
-
 
11357
      DXTImage := nil;
-
 
11358
    end;
-
 
11359
  finally
-
 
11360
    TexImage.Free;
-
 
11361
  end
-
 
11362
end;
-
 
11363
 
-
 
11364
{$IFDEF D3DRM}
-
 
11365
 
6142
{  TDirect3DRMUserVisual  }
11366
{  TDirect3DRMUserVisual  }
6143
 
11367
 
6144
procedure TDirect3DRMUserVisual_D3DRMOBJECTCALLBACK(lpD3DRMobj: IDirect3DRMObject;
11368
procedure TDirect3DRMUserVisual_D3DRMOBJECTCALLBACK(lpD3DRMobj: IDirect3DRMObject;
6145
  lpArg: Pointer); CDECL;
11369
  lpArg: Pointer); cdecl;
6146
begin
11370
begin
6147
  TDirect3DRMUserVisual(lpArg).Free;
11371
  TDirect3DRMUserVisual(lpArg).Free;
6148
end;
11372
end;
6149
 
11373
 
6150
function TDirect3DRMUserVisual_D3DRMUSERVISUALCALLBACK(lpD3DRMUV: IDirect3DRMUserVisual;
11374
function TDirect3DRMUserVisual_D3DRMUSERVISUALCALLBACK(lpD3DRMUV: IDirect3DRMUserVisual;
6151
  lpArg: Pointer; lpD3DRMUVreason: TD3DRMUserVisualReason;
11375
  lpArg: Pointer; lpD3DRMUVreason: TD3DRMUserVisualReason;
6152
  lpD3DRMDev: IDirect3DRMDevice; lpD3DRMview: IDirect3DRMViewport): Integer; CDECL;
11376
  lpD3DRMDev: IDirect3DRMDevice; lpD3DRMview: IDirect3DRMViewport): Integer; cdecl;
6153
begin
11377
begin
6154
  Result := TDirect3DRMUserVisual(lpArg).DoRender(lpD3DRMUVreason, lpD3DRMDev, lpD3DRMview);
11378
  Result := TDirect3DRMUserVisual(lpArg).DoRender(lpD3DRMUVreason, lpD3DRMDev, lpD3DRMview);
6155
end;
11379
end;
6156
 
11380
 
6157
constructor TDirect3DRMUserVisual.Create(D3DRM: IDirect3DRM);
11381
constructor TDirect3DRMUserVisual.Create(D3DRM: IDirect3DRM);
6158
begin
11382
begin
6159
  inherited Create;
11383
  inherited Create;
6160
 
11384
 
6161
  if D3DRM.CreateUserVisual(@TDirect3DRMUserVisual_D3DRMUSERVISUALCALLBACK,
11385
  if D3DRM.CreateUserVisual(@TDirect3DRMUserVisual_D3DRMUSERVISUALCALLBACK,
6162
    Self, FUserVisual)<>D3DRM_OK then
11386
    Self, FUserVisual) <> D3DRM_OK
-
 
11387
  then
6163
    raise EDirect3DRMUserVisualError.CreateFmt(SCannotMade, ['IDirect3DRMUserVisual']);
11388
    raise EDirect3DRMUserVisualError.CreateFmt(SCannotMade, ['IDirect3DRMUserVisual']);
6164
 
11389
 
6165
  FUserVisual.AddDestroyCallback(@TDirect3DRMUserVisual_D3DRMOBJECTCALLBACK, Self);
11390
  FUserVisual.AddDestroyCallback(@TDirect3DRMUserVisual_D3DRMOBJECTCALLBACK, Self);
6166
end;
11391
end;
6167
 
11392
 
6168
destructor TDirect3DRMUserVisual.Destroy;
11393
destructor TDirect3DRMUserVisual.Destroy;
6169
begin
11394
begin
6170
  if FUserVisual<>nil then
11395
  if FUserVisual <> nil then
6171
    FUserVisual.DeleteDestroyCallback(@TDirect3DRMUserVisual_D3DRMOBJECTCALLBACK, Self);
11396
    FUserVisual.DeleteDestroyCallback(@TDirect3DRMUserVisual_D3DRMOBJECTCALLBACK, Self);
6172
  FUserVisual := nil;
11397
  FUserVisual := nil;
6173
  inherited Destroy;
11398
  inherited Destroy;
6174
end;
11399
end;
6175
 
11400
 
6176
function TDirect3DRMUserVisual.DoRender(Reason: TD3DRMUserVisualReason;
11401
function TDirect3DRMUserVisual.DoRender(Reason: TD3DRMUserVisualReason;
6177
  D3DRMDev: IDirect3DRMDevice; D3DRMView: IDirect3DRMViewport): HRESULT;
11402
  D3DRMDev: IDirect3DRMDevice; D3DRMView: IDirect3DRMViewport): HRESULT;
6178
begin
11403
begin
6179
  Result := 0;
11404
  Result := 0;
6180
end;
11405
end;
-
 
11406
{$ENDIF}
6181
 
11407
 
6182
{  TPictureCollectionItem  }
11408
{  TPictureCollectionItem  }
6183
 
11409
 
6184
const
-
 
6185
  SurfaceDivWidth = 512;
-
 
6186
  SurfaceDivHeight = 512;
-
 
6187
 
-
 
6188
type
11410
type
6189
  TPictureCollectionItemPattern = class(TCollectionItem)
11411
  TPictureCollectionItemPattern = class(TCollectionItem)
6190
  private
11412
  private
6191
    FRect: TRect;
11413
    FRect: TRect;
6192
    FSurface: TDirectDrawSurface;
11414
    FSurface: TDirectDrawSurface;
Line 6231... Line 11453...
6231
 
11453
 
6232
    if PrevInitialized then
11454
    if PrevInitialized then
6233
      Restore;
11455
      Restore;
6234
  end else
11456
  end else
6235
    inherited Assign(Source);
11457
    inherited Assign(Source);
6236
end;                        
11458
end;
6237
 
11459
 
6238
procedure TPictureCollectionItem.ClearSurface;
11460
procedure TPictureCollectionItem.ClearSurface;
6239
var
11461
var
6240
  i: Integer;
11462
  i: Integer;
6241
begin
11463
begin
6242
  FPatterns.Clear;
11464
  FPatterns.Clear;
6243
  for i:=0 to FSurfaceList.Count-1 do
11465
  for i := 0 to FSurfaceList.Count - 1 do
6244
    TDirectDrawSurface(FSurfaceList[i]).Free;
11466
    TDirectDrawSurface(FSurfaceList[i]).Free;
6245
  FSurfaceList.Clear;
11467
  FSurfaceList.Clear;
6246
end;
11468
end;
6247
 
11469
 
6248
function TPictureCollectionItem.GetHeight: Integer;
11470
function TPictureCollectionItem.GetHeight: Integer;
6249
begin
11471
begin
6250
  Result := FPatternHeight;
11472
  Result := FPatternHeight;
6251
  if (Result<=0) then
11473
  if (Result <= 0) then
6252
    Result := FPicture.Height;
11474
    Result := FPicture.Height;
6253
end;
11475
end;
6254
 
11476
 
6255
function TPictureCollectionItem.GetPictureCollection: TPictureCollection;
11477
function TPictureCollectionItem.GetPictureCollection: TPictureCollection;
6256
begin
11478
begin
6257
  Result := Collection as TPictureCollection;
11479
  Result := Collection as TPictureCollection;
6258
end;
11480
end;
6259
 
11481
 
6260
function TPictureCollectionItem.GetPatternRect(Index: Integer): TRect;
11482
function TPictureCollectionItem.GetPatternRect(Index: Integer): TRect;
6261
begin
11483
begin
6262
  if (Index>=0) and (index<FPatterns.Count) then
11484
  if (Index >= 0) and (index < FPatterns.Count) then
-
 
11485
    //Result := (FPatterns.Items[Index] as TPictureCollectionItemPattern).FRect
6263
    Result := TPictureCollectionItemPattern(FPatterns.Items[Index]).FRect
11486
    Result := TPictureCollectionItemPattern(FPatterns.Items[Index]).FRect
6264
  else
11487
  else
6265
    Result := Rect(0, 0, 0, 0);
11488
    Result := Rect(0, 0, 0, 0);
6266
end;
11489
end;
6267
 
11490
 
6268
function TPictureCollectionItem.GetPatternSurface(Index: Integer): TDirectDrawSurface;
11491
function TPictureCollectionItem.GetPatternSurface(Index: Integer): TDirectDrawSurface;
6269
begin
11492
begin
6270
  if (Index>=0) and (index<FPatterns.Count) then
11493
  if (Index >= 0) and (index < FPatterns.Count) then
6271
    Result := TPictureCollectionItemPattern(FPatterns.Items[Index]).FSurface
11494
    Result := TPictureCollectionItemPattern(FPatterns.Items[Index]).FSurface
6272
  else
11495
  else
6273
    Result := nil;
11496
    Result := nil;
6274
end;
11497
end;
6275
 
11498
 
6276
function TPictureCollectionItem.GetPatternCount: Integer;
11499
function TPictureCollectionItem.GetPatternCount: Integer;
6277
var
11500
var
6278
  XCount, YCount: Integer;
11501
  XCount, YCount: Integer;
6279
begin
11502
begin
6280
  if FSurfaceList.Count=0 then
11503
  if FSurfaceList.Count = 0 then
6281
  begin
11504
  begin
-
 
11505
    if PatternWidth = 0 then PatternWidth := FPicture.Width; //prevent division by zero
6282
    XCount := FPicture.Width div (PatternWidth+SkipWidth);
11506
    XCount := FPicture.Width div (PatternWidth + SkipWidth);
6283
    if FPicture.Width-XCount*(PatternWidth+SkipWidth)=PatternWidth then
11507
    if FPicture.Width - XCount * (PatternWidth + SkipWidth) = PatternWidth then
6284
     Inc(XCount);
11508
      Inc(XCount);
6285
 
-
 
-
 
11509
    if PatternHeight = 0 then PatternHeight := FPicture.Height; //prevent division by zero
6286
    YCount := FPicture.Height div (PatternHeight+SkipHeight);
11510
    YCount := FPicture.Height div (PatternHeight + SkipHeight);
6287
    if FPicture.Height-YCount*(PatternHeight+SkipHeight)=PatternHeight then
11511
    if FPicture.Height - YCount * (PatternHeight + SkipHeight) = PatternHeight then
6288
     Inc(YCount);
11512
      Inc(YCount);
6289
 
-
 
6290
    Result := XCount*YCount;
11513
    Result := XCount * YCount;
6291
  end else
11514
  end else
6292
    Result := FPatterns.Count;
11515
    Result := FPatterns.Count;
6293
end;
11516
end;
6294
 
11517
 
6295
function TPictureCollectionItem.GetWidth: Integer;
11518
function TPictureCollectionItem.GetWidth: Integer;
6296
begin
11519
begin
6297
  Result := FPatternWidth;
11520
  Result := FPatternWidth;
6298
  if (Result<=0) then
11521
  if (Result <= 0) then
6299
    Result := FPicture.Width;
11522
    Result := FPicture.Width;
6300
end;
11523
end;
6301
                                       
-
 
-
 
11524
 
6302
procedure TPictureCollectionItem.Draw(Dest: TDirectDrawSurface; X, Y,
11525
procedure TPictureCollectionItem.Draw(Dest: TDirectDrawSurface; X, Y,
6303
  PatternIndex: Integer);            
11526
  PatternIndex: Integer);
6304
begin
11527
begin
6305
  if FInitialized and (PatternIndex>=0) and (PatternIndex<FPatterns.Count) then
11528
  if FInitialized and (PatternIndex >= 0) and (PatternIndex < FPatterns.Count) then
6306
  begin
11529
  begin
-
 
11530
    {$IFDEF DrawHWAcc}
-
 
11531
    with TPictureCollection(Self.GetPictureCollection) do
-
 
11532
      if FDXDraw.CheckD3D(Dest) then
-
 
11533
      begin
-
 
11534
        FDXDraw.FD2D.{$IFNDEF VER4UP}D2DRender2{$ELSE}D2DRender{$ENDIF}(Self, Bounds(X, Y, Width, Height), PatternIndex, rtDraw{$IFNDEF VER4UP}, $FF{$ENDIF});
-
 
11535
      end
-
 
11536
      else
-
 
11537
    {$ENDIF DrawHWAcc}
6307
    with TPictureCollectionItemPattern(FPatterns.Items[PatternIndex]) do
11538
        with TPictureCollectionItemPattern(FPatterns.Items[PatternIndex]) do
6308
      Dest.Draw(X, Y, FRect, FSurface, Transparent);
11539
          Dest.Draw(X, Y, FRect, FSurface, Transparent);
6309
  end;
11540
  end;
6310
end;
11541
end;
6311
 
11542
 
-
 
11543
procedure TPictureCollectionItem.DrawFlipHV(Dest: TDirectDrawSurface; X, Y,
-
 
11544
  PatternIndex: Integer);
-
 
11545
var
-
 
11546
  flrc: trect;
-
 
11547
begin
-
 
11548
  if FInitialized and (PatternIndex >= 0) and (PatternIndex < FPatterns.Count) then
-
 
11549
    with TPictureCollectionItemPattern(FPatterns.Items[PatternIndex]) do
-
 
11550
    begin
-
 
11551
      flrc.Left := frect.right; flrc.Right := frect.left;
-
 
11552
      flrc.Top := fpicture.height - frect.top;
-
 
11553
      flrc.Bottom := fpicture.height - frect.bottom;
-
 
11554
      Dest.Draw(X, Y, Flrc, FSurface, Transparent);
-
 
11555
    end;
-
 
11556
end;
-
 
11557
 
-
 
11558
procedure TPictureCollectionItem.DrawFlipH(Dest: TDirectDrawSurface; X, Y,
-
 
11559
  PatternIndex: Integer);
-
 
11560
var
-
 
11561
  flrc: TRect;
-
 
11562
begin
-
 
11563
  if FInitialized and (PatternIndex >= 0) and (PatternIndex < FPatterns.Count) then
-
 
11564
    with TPictureCollectionItemPattern(FPatterns.Items[PatternIndex]) do
-
 
11565
    begin
-
 
11566
      if AsSigned(D2D) and D2D.CanUseD2D and (D2D.FDDraw.Surface = Dest) then
-
 
11567
      begin
-
 
11568
        flrc := frect;
-
 
11569
        Dest.MirrorFlip([rmfMirror]);
-
 
11570
      end
-
 
11571
      else
-
 
11572
      begin
-
 
11573
        flrc.Left := fpicture.width - frect.left;
-
 
11574
        flrc.Right := fpicture.width - frect.right;
-
 
11575
        flrc.Top := frect.Top; flrc.Bottom := frect.Bottom;
-
 
11576
      end;
-
 
11577
      Dest.Draw(X, Y, Flrc, FSurface, Transparent);
-
 
11578
    end;
-
 
11579
end;
-
 
11580
 
-
 
11581
procedure TPictureCollectionItem.DrawFlipV(Dest: TDirectDrawSurface; X, Y,
-
 
11582
  PatternIndex: Integer);
-
 
11583
var
-
 
11584
  flrc: TRect;
-
 
11585
begin
-
 
11586
  if FInitialized and (PatternIndex >= 0) and (PatternIndex < FPatterns.Count) then
-
 
11587
    with TPictureCollectionItemPattern(FPatterns.Items[PatternIndex]) do
-
 
11588
    begin
-
 
11589
      if AsSigned(D2D) and D2D.CanUseD2D and (D2D.FDDraw.Surface = Dest) then
-
 
11590
      begin
-
 
11591
        flrc := frect;
-
 
11592
        Dest.MirrorFlip([rmfFlip]);
-
 
11593
      end
-
 
11594
      else
-
 
11595
      begin
-
 
11596
        flrc.Left := frect.left; flrc.Right := frect.right;
-
 
11597
        flrc.Top := fpicture.height - frect.top;
-
 
11598
        flrc.Bottom := fpicture.height - frect.bottom;
-
 
11599
      end;
-
 
11600
      Dest.Draw(X, Y, Flrc, FSurface, Transparent);
-
 
11601
    end;
-
 
11602
end;
-
 
11603
 
6312
procedure TPictureCollectionItem.StretchDraw(Dest: TDirectDrawSurface; const DestRect: TRect; PatternIndex: Integer);
11604
procedure TPictureCollectionItem.StretchDraw(Dest: TDirectDrawSurface; const DestRect: TRect; PatternIndex: Integer);
6313
begin
11605
begin
6314
  if FInitialized and (PatternIndex>=0) and (PatternIndex<FPatterns.Count) then
11606
  if FInitialized and (PatternIndex >= 0) and (PatternIndex < FPatterns.Count) then
6315
  begin
11607
  begin
-
 
11608
    {$IFDEF DrawHWAcc}
-
 
11609
    with TPictureCollection(Self.GetPictureCollection) do
-
 
11610
      if FDXDraw.CheckD3D(Dest) then
-
 
11611
      begin
-
 
11612
        FDXDraw.FD2D.{$IFNDEF VER4UP}D2DRender2{$ELSE}D2DRender{$ENDIF}(Self, DestRect, PatternIndex, rtDraw{$IFNDEF VER4UP}, $FF{$ENDIF})
-
 
11613
      end
-
 
11614
      else
-
 
11615
    {$ENDIF DrawHWAcc}
6316
    with TPictureCollectionItemPattern(FPatterns.Items[PatternIndex]) do
11616
        with TPictureCollectionItemPattern(FPatterns.Items[PatternIndex]) do
6317
      Dest.StretchDraw(DestRect, FRect, FSurface, Transparent);
11617
          Dest.StretchDraw(DestRect, FRect, FSurface, Transparent);
6318
  end;
11618
  end;
6319
end;
11619
end;
6320
 
11620
 
6321
procedure TPictureCollectionItem.DrawAdd(Dest: TDirectDrawSurface; const DestRect: TRect; PatternIndex: Integer;
11621
procedure TPictureCollectionItem.DrawAdd(Dest: TDirectDrawSurface; const DestRect: TRect; PatternIndex: Integer;
6322
  Alpha: Integer);
11622
  Alpha: Integer);
6323
begin
11623
begin
6324
  if FInitialized and (PatternIndex>=0) and (PatternIndex<FPatterns.Count) then
11624
  if FInitialized and (PatternIndex >= 0) and (PatternIndex < FPatterns.Count) then
6325
  begin
11625
  begin
-
 
11626
    with TPictureCollection(Self.GetPictureCollection) do
-
 
11627
      if FDXDraw.CheckD3D(Dest) then
-
 
11628
      begin
-
 
11629
        FDXDraw.FD2D.{$IFNDEF VER4UP}D2DRender2{$ELSE}D2DRender{$ENDIF}(Self, DestRect, PatternIndex, rtAdd, Alpha)
-
 
11630
      end
-
 
11631
      else
6326
    with TPictureCollectionItemPattern(FPatterns.Items[PatternIndex]) do
11632
        with TPictureCollectionItemPattern(FPatterns.Items[PatternIndex]) do
-
 
11633
          Dest.DrawAdd(DestRect, FRect, FSurface, Transparent, Alpha);
-
 
11634
  end;
-
 
11635
end;
-
 
11636
 
-
 
11637
procedure TPictureCollectionItem.DrawAddCol(Dest: TDirectDrawSurface; const DestRect: TRect; PatternIndex: Integer;
-
 
11638
  Color: Integer; Alpha: Integer);
-
 
11639
begin
-
 
11640
  if FInitialized and (PatternIndex >= 0) and (PatternIndex < FPatterns.Count) then
-
 
11641
  begin
-
 
11642
    with TPictureCollection(Self.GetPictureCollection) do
-
 
11643
      if FDXDraw.CheckD3D(Dest) then
-
 
11644
      begin
-
 
11645
        FDXDraw.FD2D.D2DRenderCol(Self, DestRect, PatternIndex, Color, rtAdd, Alpha)
-
 
11646
      end
-
 
11647
      else
-
 
11648
        with TPictureCollectionItemPattern(FPatterns.Items[PatternIndex]) do
6327
      Dest.DrawAdd(DestRect, FRect, FSurface, Transparent, Alpha);
11649
          Dest.DrawAdd(DestRect, FRect, FSurface, Transparent, Alpha);
6328
  end;
11650
  end;
6329
end;
11651
end;
6330
 
11652
 
6331
procedure TPictureCollectionItem.DrawAlpha(Dest: TDirectDrawSurface; const DestRect: TRect; PatternIndex: Integer;
11653
procedure TPictureCollectionItem.DrawAlpha(Dest: TDirectDrawSurface; const DestRect: TRect; PatternIndex: Integer;
6332
  Alpha: Integer);
11654
  Alpha: Integer);
6333
begin
11655
begin
6334
  if FInitialized and (PatternIndex>=0) and (PatternIndex<FPatterns.Count) then
11656
  if FInitialized and (PatternIndex >= 0) and (PatternIndex < FPatterns.Count) then
6335
  begin
11657
  begin
-
 
11658
    with TPictureCollection(Self.GetPictureCollection) do
-
 
11659
      if FDXDraw.CheckD3D(Dest) then
-
 
11660
      begin
-
 
11661
        FDXDraw.FD2D.{$IFNDEF VER4UP}D2DRender2{$ELSE}D2DRender{$ENDIF}(Self, DestRect, PatternIndex, rtBlend, Alpha)
-
 
11662
      end
-
 
11663
      else
6336
    with TPictureCollectionItemPattern(FPatterns.Items[PatternIndex]) do
11664
        with TPictureCollectionItemPattern(FPatterns.Items[PatternIndex]) do
6337
      Dest.DrawAlpha(DestRect, FRect, FSurface, Transparent, Alpha);
11665
          Dest.DrawAlpha(DestRect, FRect, FSurface, Transparent, Alpha);
6338
  end;
11666
  end;
6339
end;
11667
end;
6340
 
11668
 
6341
procedure TPictureCollectionItem.DrawSub(Dest: TDirectDrawSurface; const DestRect: TRect; PatternIndex: Integer;
11669
procedure TPictureCollectionItem.DrawSub(Dest: TDirectDrawSurface; const DestRect: TRect; PatternIndex: Integer;
6342
  Alpha: Integer);
11670
  Alpha: Integer);
6343
begin
11671
begin
6344
  if FInitialized and (PatternIndex>=0) and (PatternIndex<FPatterns.Count) then
11672
  if FInitialized and (PatternIndex >= 0) and (PatternIndex < FPatterns.Count) then
6345
  begin
11673
  begin
-
 
11674
    with TPictureCollection(Self.GetPictureCollection) do
-
 
11675
      if FDXDraw.CheckD3D(Dest) then
-
 
11676
      begin
-
 
11677
        FDXDraw.FD2D.{$IFNDEF VER4UP}D2DRender2{$ELSE}D2DRender{$ENDIF}(Self, DestRect, PatternIndex, rtSub, Alpha)
-
 
11678
      end
-
 
11679
      else
6346
    with TPictureCollectionItemPattern(FPatterns.Items[PatternIndex]) do
11680
        with TPictureCollectionItemPattern(FPatterns.Items[PatternIndex]) do
-
 
11681
          Dest.DrawSub(DestRect, FRect, FSurface, Transparent, Alpha);
-
 
11682
  end;
-
 
11683
end;
-
 
11684
 
-
 
11685
procedure TPictureCollectionItem.DrawSubCol(Dest: TDirectDrawSurface; const DestRect: TRect; PatternIndex: Integer;
-
 
11686
  Color: Integer; Alpha: Integer);
-
 
11687
begin
-
 
11688
  if FInitialized and (PatternIndex >= 0) and (PatternIndex < FPatterns.Count) then
-
 
11689
  begin
-
 
11690
    with TPictureCollection(Self.GetPictureCollection) do
-
 
11691
      if FDXDraw.CheckD3D(Dest) then
-
 
11692
      begin
-
 
11693
        FDXDraw.FD2D.D2DRenderCol(Self, DestRect, PatternIndex, Color, rtSub, Alpha)
-
 
11694
      end
-
 
11695
      else
-
 
11696
        with TPictureCollectionItemPattern(FPatterns.Items[PatternIndex]) do
6347
      Dest.DrawSub(DestRect, FRect, FSurface, Transparent, Alpha);
11697
          Dest.DrawSub(DestRect, FRect, FSurface, Transparent, Alpha);
6348
  end;
11698
  end;
6349
end;
11699
end;
6350
 
11700
 
6351
procedure TPictureCollectionItem.DrawRotate(Dest: TDirectDrawSurface; X, Y, Width, Height, PatternIndex: Integer;
11701
procedure TPictureCollectionItem.DrawRotate(Dest: TDirectDrawSurface; X, Y, Width, Height, PatternIndex: Integer;
6352
  CenterX, CenterY: Double; Angle: Integer);
11702
  CenterX, CenterY: Double; Angle: single);
6353
begin
11703
begin
6354
  if FInitialized and (PatternIndex>=0) and (PatternIndex<FPatterns.Count) then
11704
  if FInitialized and (PatternIndex >= 0) and (PatternIndex < FPatterns.Count) then
6355
  begin
11705
  begin
-
 
11706
    with TPictureCollection(Self.GetPictureCollection) do
-
 
11707
      if FDXDraw.CheckD3D(Dest) then
-
 
11708
      begin
-
 
11709
        //X,Y................ Center of rotation
-
 
11710
        //Width,Height....... Picture
-
 
11711
        //PatternIndex....... Piece of picture
-
 
11712
        //CenterX,CenterY ... Center of rotation on picture
-
 
11713
        //Angle.............. Angle of rotation
-
 
11714
        FDXDraw.FD2D.D2DRenderRotate(Self, X, Y, Width, Height, PatternIndex, rtDraw, CenterX, CenterY, Angle{$IFNDEF VER4UP}, $FF{$ENDIF});
-
 
11715
      end
-
 
11716
      else
6356
    with TPictureCollectionItemPattern(FPatterns.Items[PatternIndex]) do
11717
        with TPictureCollectionItemPattern(FPatterns.Items[PatternIndex]) do
6357
      Dest.DrawRotate(X, Y, Width, Height, FRect, FSurface, CenterX, CenterY, Transparent, Angle);
11718
          Dest.DrawRotate(X, Y, Width, Height, FRect, FSurface, CenterX, CenterY, Transparent, Angle);
6358
  end;
11719
  end;
6359
end;
11720
end;
6360
 
11721
 
6361
procedure TPictureCollectionItem.DrawRotateAdd(Dest: TDirectDrawSurface; X, Y, Width, Height, PatternIndex: Integer;
11722
procedure TPictureCollectionItem.DrawRotateAdd(Dest: TDirectDrawSurface; X, Y, Width, Height, PatternIndex: Integer;
6362
  CenterX, CenterY: Double; Angle, Alpha: Integer);
11723
  CenterX, CenterY: Double; Angle: single; Alpha: Integer);
6363
begin
11724
begin
6364
  if FInitialized and (PatternIndex>=0) and (PatternIndex<FPatterns.Count) then
11725
  if FInitialized and (PatternIndex >= 0) and (PatternIndex < FPatterns.Count) then
6365
  begin
11726
  begin
-
 
11727
    with TPictureCollection(Self.GetPictureCollection) do
-
 
11728
      if FDXDraw.CheckD3D(Dest) then
-
 
11729
      begin
-
 
11730
        FDXDraw.FD2D.D2DRenderRotate(Self, X, Y, Width, Height, PatternIndex, rtAdd, CenterX, CenterY, Angle, Alpha);
-
 
11731
      end
-
 
11732
      else
6366
    with TPictureCollectionItemPattern(FPatterns.Items[PatternIndex]) do
11733
        with TPictureCollectionItemPattern(FPatterns.Items[PatternIndex]) do
6367
      Dest.DrawRotateAdd(X, Y, Width, Height, FRect, FSurface, CenterX, CenterY, Transparent, Angle, Alpha);
11734
          Dest.DrawRotateAdd(X, Y, Width, Height, FRect, FSurface, CenterX, CenterY, Transparent, Angle, Alpha);
6368
  end;
11735
  end;
6369
end;
11736
end;
6370
 
11737
 
6371
procedure TPictureCollectionItem.DrawRotateAlpha(Dest: TDirectDrawSurface; X, Y, Width, Height, PatternIndex: Integer;
11738
procedure TPictureCollectionItem.DrawRotateAlpha(Dest: TDirectDrawSurface; X, Y, Width, Height, PatternIndex: Integer;
6372
  CenterX, CenterY: Double; Angle, Alpha: Integer);
11739
  CenterX, CenterY: Double; Angle: single; Alpha: Integer);
6373
begin
11740
begin
6374
  if FInitialized and (PatternIndex>=0) and (PatternIndex<FPatterns.Count) then
11741
  if FInitialized and (PatternIndex >= 0) and (PatternIndex < FPatterns.Count) then
6375
  begin
11742
  begin
-
 
11743
    with TPictureCollection(Self.GetPictureCollection) do
-
 
11744
      if FDXDraw.CheckD3D(Dest) then
-
 
11745
      begin
-
 
11746
        FDXDraw.FD2D.D2DRenderRotate(Self, X, Y, Width, Height, PatternIndex, rtBlend, CenterX, CenterY, Angle, Alpha);
-
 
11747
      end
-
 
11748
      else
6376
    with TPictureCollectionItemPattern(FPatterns.Items[PatternIndex]) do
11749
        with TPictureCollectionItemPattern(FPatterns.Items[PatternIndex]) do
6377
      Dest.DrawRotateAlpha(X, Y, Width, Height, FRect, FSurface, CenterX, CenterY, Transparent, Angle, Alpha);
11750
          Dest.DrawRotateAlpha(X, Y, Width, Height, FRect, FSurface, CenterX, CenterY, Transparent, Angle, Alpha);
6378
  end;
11751
  end;
6379
end;
11752
end;
6380
 
11753
 
6381
procedure TPictureCollectionItem.DrawRotateSub(Dest: TDirectDrawSurface; X, Y, Width, Height, PatternIndex: Integer;
11754
procedure TPictureCollectionItem.DrawRotateSub(Dest: TDirectDrawSurface; X, Y, Width, Height, PatternIndex: Integer;
6382
  CenterX, CenterY: Double; Angle, Alpha: Integer);
11755
  CenterX, CenterY: Double; Angle: single; Alpha: Integer);
6383
begin
11756
begin
6384
  if FInitialized and (PatternIndex>=0) and (PatternIndex<FPatterns.Count) then
11757
  if FInitialized and (PatternIndex >= 0) and (PatternIndex < FPatterns.Count) then
6385
  begin
11758
  begin
-
 
11759
    with TPictureCollection(Self.GetPictureCollection) do
-
 
11760
      if FDXDraw.CheckD3D(Dest) then
-
 
11761
      begin
-
 
11762
        FDXDraw.FD2D.D2DRenderRotate(Self, X, Y, Width, Height, PatternIndex, rtSub, CenterX, CenterY, Angle, Alpha);
-
 
11763
      end
-
 
11764
      else
6386
    with TPictureCollectionItemPattern(FPatterns.Items[PatternIndex]) do
11765
        with TPictureCollectionItemPattern(FPatterns.Items[PatternIndex]) do
6387
      Dest.DrawRotateSub(X, Y, Width, Height, FRect, FSurface, CenterX, CenterY, Transparent, Angle, Alpha);
11766
          Dest.DrawRotateSub(X, Y, Width, Height, FRect, FSurface, CenterX, CenterY, Transparent, Angle, Alpha);
6388
  end;
11767
  end;
6389
end;
11768
end;
6390
 
11769
 
6391
procedure TPictureCollectionItem.DrawWaveX(Dest: TDirectDrawSurface; X, Y, Width, Height, PatternIndex: Integer;
11770
procedure TPictureCollectionItem.DrawWaveX(Dest: TDirectDrawSurface; X, Y, Width, Height, PatternIndex: Integer;
6392
  amp, Len, ph: Integer);
11771
  amp, Len, ph: Integer);
6393
begin
11772
begin
6394
  if FInitialized and (PatternIndex>=0) and (PatternIndex<FPatterns.Count) then
11773
  if FInitialized and (PatternIndex >= 0) and (PatternIndex < FPatterns.Count) then
6395
  begin
11774
  begin
-
 
11775
    with TPictureCollection(Self.GetPictureCollection) do
-
 
11776
      if FDXDraw.CheckD3D(Dest) then
-
 
11777
      begin
-
 
11778
        FDXDraw.FD2D.D2DRenderWaveX(Self, X, Y, Width, Height, PatternIndex, rtDraw,
-
 
11779
          Transparent, amp, Len, ph{$IFNDEF VER4UP}, $FF{$ENDIF});
-
 
11780
      end
-
 
11781
      else
6396
    with TPictureCollectionItemPattern(FPatterns.Items[PatternIndex]) do
11782
        with TPictureCollectionItemPattern(FPatterns.Items[PatternIndex]) do
6397
      Dest.DrawWaveX(X, Y, Width, Height, FRect, FSurface, Transparent, amp, Len, ph);
11783
          Dest.DrawWaveX(X, Y, Width, Height, FRect, FSurface, Transparent, amp, Len, ph);
6398
  end;
11784
  end;
6399
end;
11785
end;
6400
 
11786
 
6401
procedure TPictureCollectionItem.DrawWaveXAdd(Dest: TDirectDrawSurface; X, Y, Width, Height, PatternIndex: Integer;
11787
procedure TPictureCollectionItem.DrawWaveXAdd(Dest: TDirectDrawSurface; X, Y, Width, Height, PatternIndex: Integer;
6402
  amp, Len, ph, Alpha: Integer);
11788
  amp, Len, ph, Alpha: Integer);
6403
begin
11789
begin
6404
  if FInitialized and (PatternIndex>=0) and (PatternIndex<FPatterns.Count) then
11790
  if FInitialized and (PatternIndex >= 0) and (PatternIndex < FPatterns.Count) then
6405
  begin
11791
  begin
-
 
11792
    with TPictureCollection(Self.GetPictureCollection) do
-
 
11793
      if FDXDraw.CheckD3D(Dest) then
-
 
11794
      begin
-
 
11795
        FDXDraw.FD2D.D2DRenderWaveX(Self, X, Y, Width, Height, PatternIndex, rtAdd,
-
 
11796
          Transparent, amp, Len, ph, Alpha);
-
 
11797
      end
-
 
11798
      else
6406
    with TPictureCollectionItemPattern(FPatterns.Items[PatternIndex]) do
11799
        with TPictureCollectionItemPattern(FPatterns.Items[PatternIndex]) do
6407
      Dest.DrawWaveXAdd(X, Y, Width, Height, FRect, FSurface, Transparent, amp, Len, ph, Alpha);
11800
          Dest.DrawWaveXAdd(X, Y, Width, Height, FRect, FSurface, Transparent, amp, Len, ph, Alpha);
6408
  end;
11801
  end;
6409
end;
11802
end;
6410
 
11803
 
6411
procedure TPictureCollectionItem.DrawWaveXAlpha(Dest: TDirectDrawSurface; X, Y, Width, Height, PatternIndex: Integer;
11804
procedure TPictureCollectionItem.DrawWaveXAlpha(Dest: TDirectDrawSurface; X, Y, Width, Height, PatternIndex: Integer;
6412
  amp, Len, ph, Alpha: Integer);
11805
  amp, Len, ph, Alpha: Integer);
6413
begin
11806
begin
6414
  if FInitialized and (PatternIndex>=0) and (PatternIndex<FPatterns.Count) then
11807
  if FInitialized and (PatternIndex >= 0) and (PatternIndex < FPatterns.Count) then
6415
  begin
11808
  begin
-
 
11809
    with TPictureCollection(Self.GetPictureCollection) do
-
 
11810
      if FDXDraw.CheckD3D(Dest) then
-
 
11811
      begin
-
 
11812
        FDXDraw.FD2D.D2DRenderWaveX(Self, X, Y, Width, Height, PatternIndex, rtBlend,
-
 
11813
          Transparent, amp, Len, ph, Alpha);
-
 
11814
      end
-
 
11815
      else
6416
    with TPictureCollectionItemPattern(FPatterns.Items[PatternIndex]) do
11816
        with TPictureCollectionItemPattern(FPatterns.Items[PatternIndex]) do
6417
      Dest.DrawWaveXAlpha(X, Y, Width, Height, FRect, FSurface, Transparent, amp, Len, ph, Alpha);
11817
          Dest.DrawWaveXAlpha(X, Y, Width, Height, FRect, FSurface, Transparent, amp, Len, ph, Alpha);
6418
  end;
11818
  end;
6419
end;
11819
end;
6420
 
11820
 
6421
procedure TPictureCollectionItem.DrawWaveXSub(Dest: TDirectDrawSurface; X, Y, Width, Height, PatternIndex: Integer;
11821
procedure TPictureCollectionItem.DrawWaveXSub(Dest: TDirectDrawSurface; X, Y, Width, Height, PatternIndex: Integer;
6422
  amp, Len, ph, Alpha: Integer);
11822
  amp, Len, ph, Alpha: Integer);
6423
begin
11823
begin
6424
  if FInitialized and (PatternIndex>=0) and (PatternIndex<FPatterns.Count) then
11824
  if FInitialized and (PatternIndex >= 0) and (PatternIndex < FPatterns.Count) then
6425
  begin
11825
  begin
-
 
11826
    with TPictureCollection(Self.GetPictureCollection) do
-
 
11827
      if FDXDraw.CheckD3D(Dest) then
-
 
11828
      begin
-
 
11829
        FDXDraw.FD2D.D2DRenderWaveX(Self, X, Y, Width, Height, PatternIndex, rtSub,
-
 
11830
          Transparent, amp, Len, ph, Alpha);
-
 
11831
      end
-
 
11832
      else
6426
    with TPictureCollectionItemPattern(FPatterns.Items[PatternIndex]) do
11833
        with TPictureCollectionItemPattern(FPatterns.Items[PatternIndex]) do
6427
      Dest.DrawWaveXSub(X, Y, Width, Height, FRect, FSurface, Transparent, amp, Len, ph, Alpha);
11834
          Dest.DrawWaveXSub(X, Y, Width, Height, FRect, FSurface, Transparent, amp, Len, ph, Alpha);
-
 
11835
  end;
-
 
11836
end;
-
 
11837
 
-
 
11838
procedure TPictureCollectionItem.DrawWaveYSub(Dest: TDirectDrawSurface; X, Y,
-
 
11839
  Width, Height, PatternIndex, amp, Len, ph, Alpha: Integer);
-
 
11840
begin
-
 
11841
  if FInitialized and (PatternIndex >= 0) and (PatternIndex < FPatterns.Count) then
-
 
11842
  begin
-
 
11843
    with TPictureCollection(Self.GetPictureCollection) do
-
 
11844
      if FDXDraw.CheckD3D(Dest) then
-
 
11845
      begin
-
 
11846
        FDXDraw.FD2D.D2DRenderWaveY(Self, X, Y, Width, Height, PatternIndex, rtSub,
-
 
11847
          Transparent, amp, Len, ph, Alpha);
-
 
11848
      end
-
 
11849
      {there is not software version}
-
 
11850
  end;
-
 
11851
end;
-
 
11852
 
-
 
11853
procedure TPictureCollectionItem.DrawWaveY(Dest: TDirectDrawSurface; X, Y,
-
 
11854
  Width, Height, PatternIndex, amp, Len, ph: Integer);
-
 
11855
begin
-
 
11856
  if FInitialized and (PatternIndex >= 0) and (PatternIndex < FPatterns.Count) then
-
 
11857
  begin
-
 
11858
    with TPictureCollection(Self.GetPictureCollection) do
-
 
11859
      if FDXDraw.CheckD3D(Dest) then
-
 
11860
      begin
-
 
11861
        FDXDraw.FD2D.D2DRenderWaveY(Self, X, Y, Width, Height, PatternIndex, rtDraw,
-
 
11862
          Transparent, amp, Len, ph{$IFNDEF VER4UP}, $FF{$ENDIF});
-
 
11863
      end
-
 
11864
  end;
-
 
11865
end;
-
 
11866
 
-
 
11867
procedure TPictureCollectionItem.DrawWaveYAdd(Dest: TDirectDrawSurface; X, Y,
-
 
11868
  Width, Height, PatternIndex, amp, Len, ph, Alpha: Integer);
-
 
11869
begin
-
 
11870
  if FInitialized and (PatternIndex >= 0) and (PatternIndex < FPatterns.Count) then
-
 
11871
  begin
-
 
11872
    with TPictureCollection(Self.GetPictureCollection) do
-
 
11873
      if FDXDraw.CheckD3D(Dest) then
-
 
11874
      begin
-
 
11875
        FDXDraw.FD2D.D2DRenderWaveY(Self, X, Y, Width, Height, PatternIndex, rtAdd,
-
 
11876
          Transparent, amp, Len, ph, Alpha);
-
 
11877
      end
-
 
11878
  end;
-
 
11879
end;
-
 
11880
 
-
 
11881
procedure TPictureCollectionItem.DrawWaveYAlpha(Dest: TDirectDrawSurface; X, Y,
-
 
11882
  Width, Height, PatternIndex, amp, Len, ph, Alpha: Integer);
-
 
11883
begin
-
 
11884
  if FInitialized and (PatternIndex >= 0) and (PatternIndex < FPatterns.Count) then
-
 
11885
  begin
-
 
11886
    with TPictureCollection(Self.GetPictureCollection) do
-
 
11887
      if FDXDraw.CheckD3D(Dest) then
-
 
11888
      begin
-
 
11889
        FDXDraw.FD2D.D2DRenderWaveY(Self, X, Y, Width, Height, PatternIndex, rtBlend,
-
 
11890
          Transparent, amp, Len, ph, Alpha);
-
 
11891
      end
6428
  end;
11892
  end;
6429
end;
11893
end;
6430
 
11894
 
6431
procedure TPictureCollectionItem.Finalize;
11895
procedure TPictureCollectionItem.Finalize;
6432
begin
11896
begin
Line 6435... Line 11899...
6435
    FInitialized := False;
11899
    FInitialized := False;
6436
    ClearSurface;
11900
    ClearSurface;
6437
  end;
11901
  end;
6438
end;
11902
end;
6439
 
11903
 
-
 
11904
procedure TPictureCollectionItem.UpdateTag;
-
 
11905
 
-
 
11906
  function AddSurface(const SrcRect: TRect): TDirectDrawSurface;
-
 
11907
  begin
-
 
11908
    Result := TDirectDrawSurface.Create(PictureCollection.DXDraw.DDraw);
-
 
11909
    FSurfaceList.Add(Result);
-
 
11910
 
-
 
11911
    Result.SystemMemory := FSystemMemory;
-
 
11912
    Result.LoadFromGraphicRect(FPicture.Graphic, 0, 0, SrcRect);
-
 
11913
    Result.TransparentColor := Result.ColorMatch(FTransparentColor);
-
 
11914
  end;
-
 
11915
 
-
 
11916
var
-
 
11917
  x, y, x2, y2: Integer;
-
 
11918
  BlockWidth, BlockHeight, BlockXCount, BlockYCount: Integer;
-
 
11919
  Width2, Height2: Integer;
-
 
11920
  TempSurface : TDirectDrawSurface;
-
 
11921
begin
-
 
11922
  if FPicture.Graphic = nil then Exit;
-
 
11923
//  ClearSurface;
-
 
11924
  Width2 := Width + SkipWidth;
-
 
11925
  Height2 := Height + SkipHeight;
-
 
11926
 
-
 
11927
  if (Width = FPicture.Width) and (Height = FPicture.Height) then
-
 
11928
  begin
-
 
11929
    with TPictureCollectionItemPattern.Create(FPatterns) do
-
 
11930
    begin
-
 
11931
     TempSurface := TDirectDrawSurface.Create(PictureCollection.DXDraw.DDraw);
-
 
11932
     FSurface := TempSurface;
-
 
11933
      FRect := Bounds(0, 0, FPicture.Width, FPicture.Height);
-
 
11934
     TempSurface.LoadFromGraphicRect(FPicture.Graphic, 0, 0, FRect);
-
 
11935
     TempSurface.SystemMemory := FSystemMemory;
-
 
11936
     TempSurface.TransparentColor := TempSurface.ColorMatch(FTransparentColor);
-
 
11937
     FSurfaceList.Add(TempSurface);
-
 
11938
    end;
-
 
11939
  end
-
 
11940
 else
-
 
11941
 if FSystemMemory then
-
 
11942
  begin
-
 
11943
    AddSurface(Bounds(0, 0, FPicture.Width, FPicture.Height));
-
 
11944
    for y := 0 to (FPicture.Height + SkipHeight) div Height2 - 1 do
-
 
11945
      for x := 0 to (FPicture.Width + SkipWidth) div Width2 - 1 do
-
 
11946
        with TPictureCollectionItemPattern.Create(FPatterns) do
-
 
11947
        begin
-
 
11948
          FRect := Bounds(x * Width2, y * Height2, Width, Height);
-
 
11949
          FSurface := TDirectDrawSurface(FSurfaceList[0]);
-
 
11950
        end;
-
 
11951
  end
-
 
11952
  else
-
 
11953
  begin
-
 
11954
    {  Load to a video memory with dividing the image.   }
-
 
11955
    BlockWidth := Min(((SurfaceDivWidth + Width2 - 1) div Width2) * Width2,
-
 
11956
      (FPicture.Width + SkipWidth) div Width2 * Width2);
-
 
11957
    BlockHeight := Min(((SurfaceDivHeight + Height2 - 1) div Height2) * Height2,
-
 
11958
      (FPicture.Height + SkipHeight) div Height2 * Height2);
-
 
11959
 
-
 
11960
    if (BlockWidth = 0) or (BlockHeight = 0) then Exit;
-
 
11961
 
-
 
11962
    BlockXCount := (FPicture.Width + BlockWidth - 1) div BlockWidth;
-
 
11963
    BlockYCount := (FPicture.Height + BlockHeight - 1) div BlockHeight;
-
 
11964
 
-
 
11965
    for y := 0 to BlockYCount - 1 do
-
 
11966
      for x := 0 to BlockXCount - 1 do
-
 
11967
      begin
-
 
11968
        x2 := Min(BlockWidth, Max(FPicture.Width - x * BlockWidth, 0));
-
 
11969
        if x2 = 0 then x2 := BlockWidth;
-
 
11970
 
-
 
11971
        y2 := Min(BlockHeight, Max(FPicture.Height - y * BlockHeight, 0));
-
 
11972
        if y2 = 0 then y2 := BlockHeight;
-
 
11973
 
-
 
11974
        AddSurface(Bounds(x * BlockWidth, y * BlockHeight, x2, y2));
-
 
11975
      end;
-
 
11976
 
-
 
11977
    for y := 0 to (FPicture.Height + SkipHeight) div Height2 - 1 do
-
 
11978
      for x := 0 to (FPicture.Width + SkipWidth) div Width2 - 1 do
-
 
11979
      begin
-
 
11980
        x2 := x * Width2;
-
 
11981
        y2 := y * Height2;
-
 
11982
        with TPictureCollectionItemPattern.Create(FPatterns) do
-
 
11983
        begin
-
 
11984
          FRect := Bounds(x2 - (x2 div BlockWidth * BlockWidth), y2 - (y2 div BlockHeight * BlockHeight), Width, Height);
-
 
11985
          FSurface := TDirectDrawSurface(FSurfaceList[(x2 div BlockWidth) + ((y2 div BlockHeight) * BlockXCount)]);
-
 
11986
        end;
-
 
11987
      end;
-
 
11988
  end;
-
 
11989
end;
-
 
11990
 
6440
procedure TPictureCollectionItem.Initialize;
11991
procedure TPictureCollectionItem.Initialize;
6441
begin
11992
begin
6442
  Finalize;
11993
  Finalize;
6443
  FInitialized := PictureCollection.Initialized;
11994
  FInitialized := PictureCollection.Initialized;
-
 
11995
  UpdateTag;
6444
end;
11996
end;
6445
 
11997
 
6446
procedure TPictureCollectionItem.Restore;
11998
procedure TPictureCollectionItem.Restore;
6447
 
11999
 
6448
  function AddSurface(const SrcRect: TRect): TDirectDrawSurface;
12000
  function AddSurface(const SrcRect: TRect): TDirectDrawSurface;
Line 6458... Line 12010...
6458
var
12010
var
6459
  x, y, x2, y2: Integer;
12011
  x, y, x2, y2: Integer;
6460
  BlockWidth, BlockHeight, BlockXCount, BlockYCount: Integer;
12012
  BlockWidth, BlockHeight, BlockXCount, BlockYCount: Integer;
6461
  Width2, Height2: Integer;
12013
  Width2, Height2: Integer;
6462
begin
12014
begin
6463
  if FPicture.Graphic=nil then Exit;
12015
  if FPicture.Graphic = nil then Exit;
6464
 
12016
 
6465
  if not FInitialized then
12017
  if not FInitialized then
6466
  begin
12018
  begin
6467
    if PictureCollection.Initialized then
12019
    if PictureCollection.Initialized then
6468
      Initialize;
12020
      Initialize;
6469
    if not FInitialized then Exit;
12021
    if not FInitialized then Exit;
6470
  end;
12022
  end;
6471
 
12023
 
6472
  ClearSurface;
12024
  ClearSurface;
6473
 
12025
 
6474
  Width2 := Width+SkipWidth;
12026
  Width2 := Width + SkipWidth;
6475
  Height2 := Height+SkipHeight;
12027
  Height2 := Height + SkipHeight;
6476
 
12028
 
6477
  if (Width=FPicture.Width) and (Height=FPicture.Height) then
12029
  if (Width = FPicture.Width) and (Height = FPicture.Height) then
6478
  begin
12030
  begin
6479
    {  There is no necessity of division because the number of patterns is one.   }
12031
    {  There is no necessity of division because the number of patterns is one.   }
6480
    with TPictureCollectionItemPattern.Create(FPatterns) do
12032
    with TPictureCollectionItemPattern.Create(FPatterns) do
6481
    begin
12033
    begin
6482
      FRect := Bounds(0, 0, FPicture.Width, FPicture.Height);
12034
      FRect := Bounds(0, 0, FPicture.Width, FPicture.Height);
6483
      FSurface := AddSurface(Bounds(0, 0, FPicture.Width, FPicture.Height));
12035
      FSurface := AddSurface(Bounds(0, 0, FPicture.Width, FPicture.Height));
6484
    end;
12036
    end;
-
 
12037
  end
-
 
12038
  else
6485
  end else if FSystemMemory then
12039
  if FSystemMemory then
6486
  begin
12040
  begin
6487
    {  Load to a system memory.  }
12041
    {  Load to a system memory.  }
6488
    AddSurface(Bounds(0, 0, FPicture.Width, FPicture.Height));
12042
    AddSurface(Bounds(0, 0, FPicture.Width, FPicture.Height));
6489
 
12043
 
6490
    for y:=0 to (FPicture.Height+SkipHeight) div Height2-1 do
12044
    for y := 0 to (FPicture.Height + SkipHeight) div Height2 - 1 do
6491
      for x:=0 to (FPicture.Width+SkipWidth) div Width2-1 do
12045
      for x := 0 to (FPicture.Width + SkipWidth) div Width2 - 1 do
6492
        with TPictureCollectionItemPattern.Create(FPatterns) do
12046
        with TPictureCollectionItemPattern.Create(FPatterns) do
6493
        begin
12047
        begin
6494
          FRect := Bounds(x * Width2, y * Height2, Width, Height);
12048
          FRect := Bounds(x * Width2, y * Height2, Width, Height);
6495
          FSurface := TDirectDrawSurface(FSurfaceList[0]);
12049
          FSurface := TDirectDrawSurface(FSurfaceList[0]);
6496
        end;
12050
        end;
-
 
12051
  end
6497
  end else
12052
  else
6498
  begin
12053
  begin
6499
    {  Load to a video memory with dividing the image.   }
12054
    {  Load to a video memory with dividing the image.   }
6500
    BlockWidth := Min(((SurfaceDivWidth+Width2-1) div Width2)*Width2,
12055
    BlockWidth := Min(((SurfaceDivWidth + Width2 - 1) div Width2) * Width2,
6501
      (FPicture.Width+SkipWidth) div Width2*Width2);
12056
      (FPicture.Width + SkipWidth) div Width2 * Width2);
6502
    BlockHeight := Min(((SurfaceDivHeight+Height2-1) div Height2)*Height2,
12057
    BlockHeight := Min(((SurfaceDivHeight + Height2 - 1) div Height2) * Height2,
6503
      (FPicture.Height+SkipHeight) div Height2*Height2);
12058
      (FPicture.Height + SkipHeight) div Height2 * Height2);
6504
 
12059
 
6505
    if (BlockWidth=0) or (BlockHeight=0) then Exit;
12060
    if (BlockWidth = 0) or (BlockHeight = 0) then Exit;
6506
 
12061
 
6507
    BlockXCount := (FPicture.Width+BlockWidth-1) div BlockWidth;
12062
    BlockXCount := (FPicture.Width + BlockWidth - 1) div BlockWidth;
6508
    BlockYCount := (FPicture.Height+BlockHeight-1) div BlockHeight;
12063
    BlockYCount := (FPicture.Height + BlockHeight - 1) div BlockHeight;
6509
 
12064
 
6510
    for y:=0 to BlockYCount-1 do
12065
    for y := 0 to BlockYCount - 1 do
6511
      for x:=0 to BlockXCount-1 do
12066
      for x := 0 to BlockXCount - 1 do
6512
      begin
12067
      begin
6513
        x2 := Min(BlockWidth, Max(FPicture.Width-x*BlockWidth, 0));
12068
        x2 := Min(BlockWidth, Max(FPicture.Width - x * BlockWidth, 0));
6514
        if x2=0 then x2 := BlockWidth;
12069
        if x2 = 0 then x2 := BlockWidth;
6515
       
12070
 
6516
        y2 := Min(BlockHeight, Max(FPicture.Height-y*BlockHeight, 0));
12071
        y2 := Min(BlockHeight, Max(FPicture.Height - y * BlockHeight, 0));
6517
        if y2=0 then y2 := BlockHeight;
12072
        if y2 = 0 then y2 := BlockHeight;
6518
             
12073
 
6519
        AddSurface(Bounds(x*BlockWidth, y*BlockHeight, x2, y2));
12074
        AddSurface(Bounds(x * BlockWidth, y * BlockHeight, x2, y2));
6520
      end;
12075
      end;
6521
 
12076
 
6522
    for y:=0 to (FPicture.Height+SkipHeight) div Height2-1 do
12077
    for y := 0 to (FPicture.Height + SkipHeight) div Height2 - 1 do
6523
      for x:=0 to (FPicture.Width+SkipWidth) div Width2-1 do
12078
      for x := 0 to (FPicture.Width + SkipWidth) div Width2 - 1 do
6524
      begin
12079
      begin
6525
        x2 := x * Width2;
12080
        x2 := x * Width2;
6526
        y2 := y * Height2;
12081
        y2 := y * Height2;
6527
        with TPictureCollectionItemPattern.Create(FPatterns) do
12082
        with TPictureCollectionItemPattern.Create(FPatterns) do
6528
        begin
12083
        begin
6529
          FRect := Bounds(x2-(x2 div BlockWidth*BlockWidth), y2-(y2 div BlockHeight*BlockHeight), Width, Height);
12084
          FRect := Bounds(x2 - (x2 div BlockWidth * BlockWidth), y2 - (y2 div BlockHeight * BlockHeight), Width, Height);
6530
          FSurface := TDirectDrawSurface(FSurfaceList[(x2 div BlockWidth)+((y2 div BlockHeight)*BlockXCount)]);
12085
          FSurface := TDirectDrawSurface(FSurfaceList[(x2 div BlockWidth) + ((y2 div BlockHeight) * BlockXCount)]);
6531
        end;
12086
        end;
6532
      end;
12087
      end;
6533
  end;
12088
  end;
-
 
12089
  {Code added for better compatibility}
-
 
12090
  {When is any picture changed, then all textures cleared and list have to reloaded}
-
 
12091
  with PictureCollection do
-
 
12092
    {$IFDEF D3D_deprecated}if (do3D in FDXDraw.Options) then{$ENDIF}
-
 
12093
      if AsSigned(FDXDraw.FD2D) then
-
 
12094
        if Assigned(FDXDraw.FD2D.D2DTextures) then
-
 
12095
          FDXDraw.FD2D.D2DTextures.D2DPruneAllTextures;
6534
end;
12096
end;
6535
 
12097
 
6536
procedure TPictureCollectionItem.SetPicture(Value: TPicture);
12098
procedure TPictureCollectionItem.SetPicture(Value: TPicture);
6537
begin
12099
begin
6538
  FPicture.Assign(Value);
12100
  FPicture.Assign(Value);
Line 6541... Line 12103...
6541
procedure TPictureCollectionItem.SetTransparentColor(Value: TColor);
12103
procedure TPictureCollectionItem.SetTransparentColor(Value: TColor);
6542
var
12104
var
6543
  i: Integer;
12105
  i: Integer;
6544
  Surface: TDirectDrawSurface;
12106
  Surface: TDirectDrawSurface;
6545
begin
12107
begin
6546
  if Value<>FTransparentColor then
12108
  if Value <> FTransparentColor then
6547
  begin
12109
  begin
6548
    FTransparentColor := Value;
12110
    FTransparentColor := Value;
6549
    for i:=0 to FSurfaceList.Count-1 do
12111
    for i := 0 to FSurfaceList.Count - 1 do
6550
    begin
12112
    begin
6551
      try
12113
      try
6552
        Surface := TDirectDrawSurface(FSurfaceList[i]);
12114
        Surface := TDirectDrawSurface(FSurfaceList[i]);
6553
        Surface.TransparentColor := Surface.ColorMatch(FTransparentColor);
12115
        Surface.TransparentColor := Surface.ColorMatch(FTransparentColor);
6554
      except
12116
      except
6555
      end;
12117
      end;
6556
    end;
12118
    end;
6557
  end;
12119
  end;
6558
end;
12120
end;
6559
 
12121
 
-
 
12122
procedure TPictureCollectionItem.DrawAlphaCol(Dest: TDirectDrawSurface;
-
 
12123
  const DestRect: TRect; PatternIndex, Color, Alpha: Integer);
-
 
12124
begin
-
 
12125
  if FInitialized and (PatternIndex >= 0) and (PatternIndex < FPatterns.Count) then
-
 
12126
  begin
-
 
12127
    with TPictureCollection(Self.GetPictureCollection) do
-
 
12128
      if FDXDraw.CheckD3D(Dest) then
-
 
12129
      begin
-
 
12130
        FDXDraw.FD2D.D2DRenderCol(Self, DestRect, PatternIndex, color, rtBlend, Alpha)
-
 
12131
      end else
-
 
12132
        with TPictureCollectionItemPattern(FPatterns.Items[PatternIndex]) do
-
 
12133
          Dest.DrawAlpha(DestRect, FRect, FSurface, Transparent, Alpha);
-
 
12134
  end;
-
 
12135
end;
-
 
12136
 
-
 
12137
procedure TPictureCollectionItem.DrawRotateAddCol(Dest: TDirectDrawSurface;
-
 
12138
  X, Y, Width, Height, PatternIndex: Integer; CenterX, CenterY: Double;
-
 
12139
  Angle: single; Color, Alpha: Integer);
-
 
12140
begin
-
 
12141
  if FInitialized and (PatternIndex >= 0) and (PatternIndex < FPatterns.Count) then
-
 
12142
  begin
-
 
12143
    with TPictureCollection(Self.GetPictureCollection) do
-
 
12144
      if FDXDraw.CheckD3D(Dest) then
-
 
12145
      begin
-
 
12146
        FDXDraw.FD2D.D2DRenderRotateModeCol(Self, rtAdd, X, Y, Width,
-
 
12147
          Height, PatternIndex, CenterX, CenterY, Angle, Color, Alpha);
-
 
12148
      end
-
 
12149
      else
-
 
12150
        with TPictureCollectionItemPattern(FPatterns.Items[PatternIndex]) do
-
 
12151
          Dest.DrawRotateAdd(X, Y, Width, Height, FRect, FSurface, CenterX, CenterY, Transparent, Angle, Alpha);
-
 
12152
  end;
-
 
12153
end;
-
 
12154
 
-
 
12155
procedure TPictureCollectionItem.DrawRotateAlphaCol(Dest: TDirectDrawSurface;
-
 
12156
  X, Y, Width, Height, PatternIndex: Integer; CenterX, CenterY: Double;
-
 
12157
  Angle: single; Color, Alpha: Integer);
-
 
12158
begin
-
 
12159
  if FInitialized and (PatternIndex >= 0) and (PatternIndex < FPatterns.Count) then
-
 
12160
  begin
-
 
12161
    with TPictureCollection(Self.GetPictureCollection) do
-
 
12162
      if FDXDraw.CheckD3D(Dest) then
-
 
12163
      begin
-
 
12164
        FDXDraw.FD2D.D2DRenderRotateModeCol(Self, rtBlend, X, Y, Width,
-
 
12165
          Height, PatternIndex, CenterX, CenterY, Angle, Color, Alpha);
-
 
12166
      end
-
 
12167
      else
-
 
12168
        with TPictureCollectionItemPattern(FPatterns.Items[PatternIndex]) do
-
 
12169
          Dest.DrawRotateAlpha(X, Y, Width, Height, FRect, FSurface, CenterX, CenterY, Transparent, Angle, Alpha);
-
 
12170
  end;
-
 
12171
end;
-
 
12172
 
-
 
12173
procedure TPictureCollectionItem.DrawRotateSubCol(Dest: TDirectDrawSurface;
-
 
12174
  X, Y, Width, Height, PatternIndex: Integer; CenterX, CenterY: Double;
-
 
12175
  Angle: single; Color, Alpha: Integer);
-
 
12176
begin
-
 
12177
  if FInitialized and (PatternIndex >= 0) and (PatternIndex < FPatterns.Count) then
-
 
12178
  begin
-
 
12179
    with TPictureCollection(Self.GetPictureCollection) do
-
 
12180
      if FDXDraw.CheckD3D(Dest) then
-
 
12181
      begin
-
 
12182
        FDXDraw.FD2D.D2DRenderRotateModeCol(Self, rtSub, X, Y, Width,
-
 
12183
          Height, PatternIndex, CenterX, CenterY, Angle, Color, Alpha);
-
 
12184
      end
-
 
12185
      else
-
 
12186
        with TPictureCollectionItemPattern(FPatterns.Items[PatternIndex]) do
-
 
12187
          Dest.DrawRotateSub(X, Y, Width, Height, FRect, FSurface, CenterX, CenterY, Transparent, Angle, Alpha);
-
 
12188
  end;
-
 
12189
end;
-
 
12190
 
-
 
12191
procedure TPictureCollectionItem.DrawCol(Dest: TDirectDrawSurface;
-
 
12192
  const DestRect, SourceRect: TRect; PatternIndex: Integer; Faded: Boolean;
-
 
12193
  RenderType: TRenderType; Color, Specular: Integer; Alpha: Integer);
-
 
12194
begin
-
 
12195
  if FInitialized and (PatternIndex >= 0) and (PatternIndex < FPatterns.Count) then
-
 
12196
  begin
-
 
12197
    with TPictureCollection(Self.GetPictureCollection) do
-
 
12198
      if FDXDraw.CheckD3D(Dest) then
-
 
12199
      begin
-
 
12200
        FDXDraw.FD2D.D2DRenderColoredPartition(Self, DestRect, PatternIndex,
-
 
12201
          Color, Specular, Faded, SourceRect, RenderType,
-
 
12202
          Alpha)
-
 
12203
      end
-
 
12204
      else
-
 
12205
        with TPictureCollectionItemPattern(FPatterns.Items[PatternIndex]) do
-
 
12206
          Dest.DrawAlpha(DestRect, FRect, FSurface, Transparent, Alpha);
-
 
12207
  end;
-
 
12208
end;
-
 
12209
 
-
 
12210
procedure TPictureCollectionItem.DrawRect(Dest: TDirectDrawSurface;
-
 
12211
  const DestRect, SourceRect: TRect; PatternIndex: Integer;
-
 
12212
  RenderType: TRenderType; Transparent: Boolean; Alpha: Integer);
-
 
12213
begin
-
 
12214
  if FInitialized and (PatternIndex >= 0) and (PatternIndex < FPatterns.Count) then
-
 
12215
  begin
-
 
12216
    {$IFDEF DrawHWAcc}
-
 
12217
    with TPictureCollection(Self.GetPictureCollection) do
-
 
12218
      if FDXDraw.CheckD3D(Dest) then
-
 
12219
      begin
-
 
12220
        FDXDraw.FD2D.D2DRender(Self, DestRect, PatternIndex, SourceRect, RenderType, Alpha);
-
 
12221
      end
-
 
12222
      else
-
 
12223
    {$ENDIF DrawHWAcc}
-
 
12224
        with TPictureCollectionItemPattern(FPatterns.Items[PatternIndex]) do
-
 
12225
        begin
-
 
12226
          case RenderType of
-
 
12227
            rtDraw: Dest.StretchDraw(DestRect, SourceRect, FSurface, Transparent);
-
 
12228
              //Dest.Draw(DestRect.Left, DestRect.Top, SourceRect, FSurface, Transparent);
-
 
12229
            rtBlend: Dest.DrawAlpha(DestRect, SourceRect, FSurface, Transparent, Alpha);
-
 
12230
            rtAdd: Dest.DrawAdd(DestRect, SourceRect, FSurface, Transparent, Alpha);
-
 
12231
            rtSub: Dest.DrawSub(DestRect, SourceRect, FSurface, Transparent, Alpha);
-
 
12232
          end;
-
 
12233
        end;
-
 
12234
  end;
-
 
12235
end;
-
 
12236
 
6560
{  TPictureCollection  }
12237
{  TPictureCollection  }
6561
 
12238
 
6562
constructor TPictureCollection.Create(AOwner: TPersistent);
12239
constructor TPictureCollection.Create(AOwner: TPersistent);
6563
begin
12240
begin
6564
  inherited Create(TPictureCollectionItem);
12241
  inherited Create(TPictureCollectionItem);
Line 6584... Line 12261...
6584
function TPictureCollection.Find(const Name: string): TPictureCollectionItem;
12261
function TPictureCollection.Find(const Name: string): TPictureCollectionItem;
6585
var
12262
var
6586
  i: Integer;
12263
  i: Integer;
6587
begin
12264
begin
6588
  i := IndexOf(Name);
12265
  i := IndexOf(Name);
6589
  if i=-1 then
12266
  if i = -1 then
6590
    raise EPictureCollectionError.CreateFmt(SImageNotFound, [Name]);
12267
    raise EPictureCollectionError.CreateFmt(SImageNotFound, [Name]);
6591
  Result := Items[i];
12268
  Result := Items[i];
6592
end;
12269
end;
6593
 
12270
 
6594
procedure TPictureCollection.Finalize;
12271
procedure TPictureCollection.Finalize;
6595
var
12272
var
6596
  i: Integer;
12273
  i: Integer;
6597
begin
12274
begin
6598
  try
12275
  try
6599
    for i:=0 to Count-1 do
12276
    for i := 0 to Count - 1 do
6600
      Items[i].Finalize;
12277
      Items[i].Finalize;
6601
  finally
12278
  finally
6602
    FDXDraw := nil;
12279
    FDXDraw := nil;
6603
  end;
12280
  end;
6604
end;
12281
end;
6605
 
12282
 
-
 
12283
procedure TPictureCollection.InitializeImages(DXDraw: TCustomDXDraw; Id : Integer);
-
 
12284
var
-
 
12285
  i: Integer;
-
 
12286
begin
-
 
12287
  If id = -1 Then
-
 
12288
   Finalize;
-
 
12289
  FDXDraw := DXDraw;
-
 
12290
 
-
 
12291
  if not Initialized then
-
 
12292
    raise EPictureCollectionError.CreateFmt(SCannotInitialized, [ClassName]);
-
 
12293
 
-
 
12294
  for i := 0 to Count - 1 do
-
 
12295
   If (id = -1) or (id = i) Then
-
 
12296
    Items[i].Initialize;
-
 
12297
end;
-
 
12298
 
6606
procedure TPictureCollection.Initialize(DXDraw: TCustomDXDraw);
12299
procedure TPictureCollection.Initialize(DXDraw: TCustomDXDraw);
6607
var
12300
var
6608
  i: Integer;
12301
  i: Integer;
6609
begin
12302
begin
6610
  Finalize;
12303
  Finalize;
6611
  FDXDraw := DXDraw;
12304
  FDXDraw := DXDraw;
6612
 
12305
 
6613
  if not Initialized then
12306
  if not Initialized then
6614
    raise EPictureCollectionError.CreateFmt(SCannotInitialized, [ClassName]);
12307
    raise EPictureCollectionError.CreateFmt(SCannotInitialized, [ClassName]);
6615
 
12308
 
6616
  for i:=0 to Count-1 do
12309
  for i := 0 to Count - 1 do
6617
    Items[i].Initialize;
12310
    Items[i].Initialize;
6618
end;
12311
end;
6619
 
12312
 
6620
function TPictureCollection.Initialized: Boolean;
12313
function TPictureCollection.Initialized: Boolean;
6621
begin
12314
begin
6622
  Result := (FDXDraw<>nil) and (FDXDraw.Initialized);
12315
  Result := (FDXDraw <> nil) and (FDXDraw.Initialized);
6623
end;
12316
end;
6624
 
12317
 
6625
procedure TPictureCollection.Restore;
12318
procedure TPictureCollection.Restore;
6626
var
12319
var
6627
  i: Integer;
12320
  i: Integer;
6628
begin
12321
begin
6629
  for i:=0 to Count-1 do
12322
  for i := 0 to Count - 1 do
6630
    Items[i].Restore;
12323
    Items[i].Restore;
6631
end;
12324
end;
6632
 
12325
 
6633
procedure TPictureCollection.MakeColorTable;
12326
procedure TPictureCollection.MakeColorTable;
6634
var
12327
var
Line 6644... Line 12337...
6644
 
12337
 
6645
  procedure AddColor(Col: TRGBQuad);
12338
  procedure AddColor(Col: TRGBQuad);
6646
  var
12339
  var
6647
    i: Integer;
12340
    i: Integer;
6648
  begin
12341
  begin
6649
    for i:=0 to 255 do
12342
    for i := 0 to 255 do
6650
      if UseColorTable[i] then
12343
      if UseColorTable[i] then
6651
        if DWORD(ColorTable[i])=DWORD(Col) then
12344
        if DWORD(ColorTable[i]) = DWORD(Col) then
6652
          Exit;
12345
          Exit;
6653
    for i:=0 to 255 do
12346
    for i := 0 to 255 do
6654
      if not UseColorTable[i] then
12347
      if not UseColorTable[i] then
6655
      begin
12348
      begin
6656
        SetColor(i, Col);
12349
        SetColor(i, Col);
6657
        Exit;
12350
        Exit;
6658
      end;
12351
      end;
Line 6660... Line 12353...
6660
 
12353
 
6661
  procedure AddDIB(DIB: TDIB);
12354
  procedure AddDIB(DIB: TDIB);
6662
  var
12355
  var
6663
    i: Integer;
12356
    i: Integer;
6664
  begin
12357
  begin
6665
    if DIB.BitCount>8 then Exit;
12358
    if DIB.BitCount > 8 then Exit;
6666
 
12359
 
6667
    for i:=0 to 255 do
12360
    for i := 0 to 255 do
6668
      AddColor(DIB.ColorTable[i]);
12361
      AddColor(DIB.ColorTable[i]);
6669
  end;
12362
  end;
6670
 
12363
 
6671
  procedure AddGraphic(Graphic: TGraphic);
12364
  procedure AddGraphic(Graphic: TGraphic);
6672
  var
12365
  var
6673
    i, n: Integer;
12366
    i, n: Integer;
6674
    PaletteEntries: TPaletteEntries;
12367
    PaletteEntries: TPaletteEntries;
6675
  begin
12368
  begin
6676
    if Graphic.Palette<>0 then
12369
    if Graphic.Palette <> 0 then
6677
    begin
12370
    begin
6678
      n := GetPaletteEntries(Graphic.Palette, 0, 256, PaletteEntries);
12371
      n := GetPaletteEntries(Graphic.Palette, 0, 256, PaletteEntries);
6679
      for i:=0 to n-1 do
12372
      for i := 0 to n - 1 do
6680
        AddColor(PaletteEntryToRGBQuad(PaletteEntries[i]));
12373
        AddColor(PaletteEntryToRGBQuad(PaletteEntries[i]));
6681
    end;
12374
    end;
6682
  end;
12375
  end;
6683
 
12376
 
6684
var
12377
var
Line 6706... Line 12399...
6706
  SetColor(252, RGBQuad(0, 0, 255));
12399
  SetColor(252, RGBQuad(0, 0, 255));
6707
  SetColor(253, RGBQuad(255, 0, 255));
12400
  SetColor(253, RGBQuad(255, 0, 255));
6708
  SetColor(254, RGBQuad(0, 255, 255));
12401
  SetColor(254, RGBQuad(0, 255, 255));
6709
  SetColor(255, RGBQuad(255, 255, 255));
12402
  SetColor(255, RGBQuad(255, 255, 255));
6710
 
12403
 
6711
  for i:=0 to Count-1 do
12404
  for i := 0 to Count - 1 do
6712
    if Items[i].Picture.Graphic<>nil then
12405
    if Items[i].Picture.Graphic <> nil then
6713
    begin
12406
    begin
6714
      if Items[i].Picture.Graphic is TDIB then
12407
      if Items[i].Picture.Graphic is TDIB then
6715
        AddDIB(TDIB(Items[i].Picture.Graphic))
12408
        AddDIB(TDIB(Items[i].Picture.Graphic))
6716
      else
12409
      else
6717
        AddGraphic(Items[i].Picture.Graphic);
12410
        AddGraphic(Items[i].Picture.Graphic);
6718
      if PaletteCount=256 then Break;
12411
      if PaletteCount = 256 then Break;
6719
    end;
12412
    end;
6720
end;
12413
end;
6721
 
12414
 
6722
procedure TPictureCollection.DefineProperties(Filer: TFiler);
12415
procedure TPictureCollection.DefineProperties(Filer: TFiler);
6723
begin
12416
begin
Line 6817... Line 12510...
6817
 
12510
 
6818
procedure TCustomDXImageList.Notification(AComponent: TComponent;
12511
procedure TCustomDXImageList.Notification(AComponent: TComponent;
6819
  Operation: TOperation);
12512
  Operation: TOperation);
6820
begin
12513
begin
6821
  inherited Notification(AComponent, Operation);
12514
  inherited Notification(AComponent, Operation);
6822
  if (Operation=opRemove) and (DXDraw=AComponent) then
12515
  if (Operation = opRemove) and (DXDraw = AComponent) then
6823
    DXDraw := nil;
12516
    DXDraw := nil;
6824
end;
12517
end;
6825
 
12518
 
6826
procedure TCustomDXImageList.DXDrawNotifyEvent(Sender: TCustomDXDraw;
12519
procedure TCustomDXImageList.DXDrawNotifyEvent(Sender: TCustomDXDraw;
6827
  NotifyType: TDXDrawNotifyType);
12520
  NotifyType: TDXDrawNotifyType);
6828
begin
12521
begin
6829
  case NotifyType of
12522
  case NotifyType of
6830
    dxntDestroying: DXDraw := nil;
12523
    dxntDestroying: DXDraw := nil;
6831
    dxntInitialize: FItems.Initialize(Sender);
12524
    dxntInitialize: FItems.Initialize(Sender);
6832
    dxntFinalize  : FItems.Finalize;
12525
    dxntFinalize: FItems.Finalize;
6833
    dxntRestore   : FItems.Restore;
12526
    dxntRestore: FItems.Restore;
6834
  end;
12527
  end;
6835
end;
12528
end;
6836
 
12529
 
6837
procedure TCustomDXImageList.SetDXDraw(Value: TCustomDXDraw);
12530
procedure TCustomDXImageList.SetDXDraw(Value: TCustomDXDraw);
6838
begin
12531
begin
6839
  if FDXDraw<>nil then
12532
  if FDXDraw <> nil then
6840
    FDXDraw.UnRegisterNotifyEvent(DXDrawNotifyEvent);
12533
    FDXDraw.UnRegisterNotifyEvent(DXDrawNotifyEvent);
6841
 
12534
 
6842
  FDXDraw := Value;
12535
  FDXDraw := Value;
6843
 
12536
 
6844
  if FDXDraw<>nil then
12537
  if FDXDraw <> nil then
6845
    FDXDraw.RegisterNotifyEvent(DXDrawNotifyEvent);
12538
    FDXDraw.RegisterNotifyEvent(DXDrawNotifyEvent);
6846
end;
12539
end;
6847
 
12540
 
6848
procedure TCustomDXImageList.SetItems(Value: TPictureCollection);
12541
procedure TCustomDXImageList.SetItems(Value: TPictureCollection);
6849
begin
12542
begin
Line 6859... Line 12552...
6859
  FTargetSurface := TargetSurface;
12552
  FTargetSurface := TargetSurface;
6860
  FVisible := True;
12553
  FVisible := True;
6861
end;
12554
end;
6862
 
12555
 
6863
constructor TDirectDrawOverlay.CreateWindowed(WindowHandle: HWND);
12556
constructor TDirectDrawOverlay.CreateWindowed(WindowHandle: HWND);
-
 
12557
{$IFDEF D3D_deprecated}
6864
const
12558
const
6865
  PrimaryDesc: TDDSurfaceDesc = (
12559
  PrimaryDesc: TDDSurfaceDesc = (
6866
      dwSize: SizeOf(PrimaryDesc);
12560
    dwSize: SizeOf(PrimaryDesc);
6867
      dwFlags: DDSD_CAPS;
12561
    dwFlags: DDSD_CAPS;
6868
      ddsCaps: (dwCaps: DDSCAPS_PRIMARYSURFACE)
12562
    ddsCaps: (dwCaps: DDSCAPS_PRIMARYSURFACE)
6869
      );
12563
    );
-
 
12564
{$ELSE}
-
 
12565
var
-
 
12566
  PrimaryDesc: TDDSurfaceDesc2;
-
 
12567
{$ENDIF}
6870
begin
12568
begin
6871
  FDDraw2 := TDirectDraw.CreateEx(nil, False);
12569
  FDDraw2 := TDirectDraw.CreateEx(nil, False);
6872
  if FDDraw2.IDraw.SetCooperativeLevel(WindowHandle, DDSCL_NORMAL)<>DD_OK then
12570
  if FDDraw2.{$IFDEF D3D_deprecated}IDraw{$ELSE}IDraw7{$ENDIF}.SetCooperativeLevel(WindowHandle, DDSCL_NORMAL) <> DD_OK then
6873
    raise EDirectDrawOverlayError.CreateFmt(SCannotInitialized, [SOverlay]);
12571
    raise EDirectDrawOverlayError.CreateFmt(SCannotInitialized, [SOverlay]);
6874
 
12572
 
6875
  FTargetSurface2 := TDirectDrawSurface.Create(FDDraw2);
12573
  FTargetSurface2 := TDirectDrawSurface.Create(FDDraw2);
-
 
12574
  {$IFNDEF D3D_deprecated}
-
 
12575
  FillChar(PrimaryDesc, SizeOf(PrimaryDesc), 0);
-
 
12576
  PrimaryDesc.dwSize := SizeOf(PrimaryDesc);
-
 
12577
  PrimaryDesc.dwFlags := DDSD_CAPS;
-
 
12578
  PrimaryDesc.ddsCaps.dwCaps := DDSCAPS_PRIMARYSURFACE;
-
 
12579
  {$ENDIF}
6876
  if not FTargetSurface2.CreateSurface(PrimaryDesc) then
12580
  if not FTargetSurface2.CreateSurface(PrimaryDesc) then
6877
    raise EDirectDrawOverlayError.CreateFmt(SCannotInitialized, [SOverlay]);
12581
    raise EDirectDrawOverlayError.CreateFmt(SCannotInitialized, [SOverlay]);
6878
 
12582
 
6879
  Create(FDDraw2, FTargetSurface2);
12583
  Create(FDDraw2, FTargetSurface2);
6880
end;
12584
end;
Line 6891... Line 12595...
6891
begin
12595
begin
6892
  FBackSurface.Free; FBackSurface := nil;
12596
  FBackSurface.Free; FBackSurface := nil;
6893
  FSurface.Free; FSurface := nil;
12597
  FSurface.Free; FSurface := nil;
6894
end;
12598
end;
6895
 
12599
 
6896
procedure TDirectDrawOverlay.Initialize(const SurfaceDesc: TDDSurfaceDesc);
12600
procedure TDirectDrawOverlay.Initialize(const SurfaceDesc: {$IFDEF D3D_deprecated}TDDSurfaceDesc{$ELSE}TDDSurfaceDesc2{$ENDIF});
-
 
12601
{$IFDEF D3D_deprecated}
6897
const
12602
const
6898
  BackBufferCaps: TDDSCaps = (dwCaps: DDSCAPS_BACKBUFFER);
12603
  BackBufferCaps: TDDSCaps = (dwCaps: DDSCAPS_BACKBUFFER);
6899
var
12604
var
6900
  DDSurface: IDirectDrawSurface;
12605
  DDSurface: IDirectDrawSurface;
-
 
12606
{$ELSE}
-
 
12607
var
-
 
12608
  DDSurface: IDirectDrawSurface7;
-
 
12609
  BackBufferCaps: TDDSCaps2;
-
 
12610
{$ENDIF}
6901
begin
12611
begin
6902
  Finalize;
12612
  Finalize;
6903
  try
12613
  try
6904
    FSurface := TDirectDrawSurface.Create(FDDraw);
12614
    FSurface := TDirectDrawSurface.Create(FDDraw);
6905
    if not FSurface.CreateSurface(SurfaceDesc) then
12615
    if not FSurface.CreateSurface(SurfaceDesc) then
6906
      raise EDirectDrawOverlayError.CreateFmt(SCannotInitialized, [SOverlay]);
12616
      raise EDirectDrawOverlayError.CreateFmt(SCannotInitialized, [SOverlay]);
6907
 
12617
 
6908
    FBackSurface := TDirectDrawSurface.Create(FDDraw);
12618
    FBackSurface := TDirectDrawSurface.Create(FDDraw);
-
 
12619
    {$IFNDEF D3D_deprecated}
6909
                                                       
12620
    BackBufferCaps.dwCaps := DDSCAPS_BACKBUFFER;
-
 
12621
    {$ENDIF}
6910
    if SurfaceDesc.ddsCaps.dwCaps and DDSCAPS_FLIP<>0 then
12622
    if SurfaceDesc.ddsCaps.dwCaps and DDSCAPS_FLIP <> 0 then
6911
    begin
12623
    begin
6912
      if FSurface.ISurface.GetAttachedSurface(BackBufferCaps, DDSurface)=DD_OK then
12624
      if FSurface.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}.GetAttachedSurface(BackBufferCaps, DDSurface) = DD_OK then
6913
        FBackSurface.IDDSurface := DDSurface;
12625
        FBackSurface.{$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF} := DDSurface;
-
 
12626
    end
6914
    end else
12627
    else
6915
      FBackSurface.IDDSurface := FSurface.IDDSurface;
12628
      FBackSurface.{$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF} := FSurface.{$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF};
6916
 
12629
 
6917
    if FVisible then
12630
    if FVisible then
6918
      SetOverlayRect(FOverlayRect)
12631
      SetOverlayRect(FOverlayRect)
6919
    else
12632
    else
6920
      FSurface.ISurface.UpdateOverlay(PRect(nil)^, FTargetSurface.ISurface, PRect(nil)^, DDOVER_HIDE, PDDOverlayFX(nil)^);
12633
      FSurface.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}.UpdateOverlay(PRect(nil), FTargetSurface.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, PRect(nil), DDOVER_HIDE, PDDOverlayFX(nil));
6921
  except
12634
  except
6922
    Finalize;
12635
    Finalize;
6923
    raise;
12636
    raise;
6924
  end;
12637
  end;
6925
end;
12638
end;
6926
 
12639
 
6927
procedure TDirectDrawOverlay.Flip;
12640
procedure TDirectDrawOverlay.Flip;
6928
begin
12641
begin
6929
  if FSurface=nil then Exit;
12642
  if FSurface = nil then Exit;
6930
 
12643
 
6931
  if FSurface.SurfaceDesc.ddsCaps.dwCaps and DDSCAPS_FLIP<>0 then
12644
  if FSurface.SurfaceDesc.ddsCaps.dwCaps and DDSCAPS_FLIP <> 0 then
6932
    FSurface.ISurface.Flip(nil, DDFLIP_WAIT);
12645
    FSurface.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}.Flip(nil, DDFLIP_WAIT);
6933
end;
12646
end;
6934
 
12647
 
6935
procedure TDirectDrawOverlay.SetOverlayColorKey(Value: TColor);
12648
procedure TDirectDrawOverlay.SetOverlayColorKey(Value: TColor);
6936
begin
12649
begin
6937
  FOverlayColorKey := Value;
12650
  FOverlayColorKey := Value;
6938
  if FSurface<>nil then
12651
  if FSurface <> nil then
6939
    SetOverlayRect(FOverlayRect);
12652
    SetOverlayRect(FOverlayRect);
6940
end;
12653
end;
6941
 
12654
 
6942
procedure TDirectDrawOverlay.SetOverlayRect(const Value: TRect);
12655
procedure TDirectDrawOverlay.SetOverlayRect(const Value: TRect);
6943
var
12656
var
Line 6945... Line 12658...
6945
  XScaleRatio, YScaleRatio: Integer;
12658
  XScaleRatio, YScaleRatio: Integer;
6946
  OverlayFX: TDDOverlayFX;
12659
  OverlayFX: TDDOverlayFX;
6947
  OverlayFlags: DWORD;
12660
  OverlayFlags: DWORD;
6948
begin
12661
begin
6949
  FOverlayRect := Value;
12662
  FOverlayRect := Value;
6950
  if (FSurface<>nil) and FVisible then
12663
  if (FSurface <> nil) and FVisible then
6951
  begin
12664
  begin
6952
    DestRect := FOverlayRect;
12665
    DestRect := FOverlayRect;
6953
    SrcRect.Left := 0;
12666
    SrcRect.Left := 0;
6954
    SrcRect.Top := 0;
12667
    SrcRect.Top := 0;
6955
    SrcRect.Right := FSurface.SurfaceDesc.dwWidth;
12668
    SrcRect.Right := FSurface.SurfaceDesc.dwWidth;
Line 6962... Line 12675...
6962
 
12675
 
6963
    {  Scale rate limitation  }
12676
    {  Scale rate limitation  }
6964
    XScaleRatio := (DestRect.right - DestRect.left) * 1000 div (SrcRect.right - SrcRect.left);
12677
    XScaleRatio := (DestRect.right - DestRect.left) * 1000 div (SrcRect.right - SrcRect.left);
6965
    YScaleRatio := (DestRect.bottom - DestRect.top) * 1000 div (SrcRect.bottom - SrcRect.top);
12678
    YScaleRatio := (DestRect.bottom - DestRect.top) * 1000 div (SrcRect.bottom - SrcRect.top);
6966
 
12679
 
6967
    if (FDDraw.DriverCaps.dwCaps and DDCAPS_OVERLAYSTRETCH<>0) and
12680
    if (FDDraw.DriverCaps.dwCaps and DDCAPS_OVERLAYSTRETCH <> 0)
-
 
12681
      and (FDDraw.DriverCaps.dwMinOverlayStretch <> 0)
6968
      (FDDraw.DriverCaps.dwMinOverlayStretch<>0) and (XScaleRatio<Integer(FDDraw.DriverCaps.dwMinOverlayStretch)) then
12682
      and (XScaleRatio < Integer(FDDraw.DriverCaps.dwMinOverlayStretch))
-
 
12683
    then
6969
    begin
12684
    begin
6970
      DestRect.Right := DestRect.Left + (Integer(FSurface.SurfaceDesc.dwWidth) * (Integer(FDDraw.DriverCaps.dwMinOverlayStretch) + 1)) div 1000;
12685
      DestRect.Right := DestRect.Left + (Integer(FSurface.SurfaceDesc.dwWidth) * (Integer(FDDraw.DriverCaps.dwMinOverlayStretch) + 1)) div 1000;
6971
    end;
12686
    end;
6972
 
12687
 
6973
    if (FDDraw.DriverCaps.dwCaps and DDCAPS_OVERLAYSTRETCH<>0) and
12688
    if (FDDraw.DriverCaps.dwCaps and DDCAPS_OVERLAYSTRETCH <> 0)
-
 
12689
      and (FDDraw.DriverCaps.dwMaxOverlayStretch <> 0)
6974
      (FDDraw.DriverCaps.dwMaxOverlayStretch<>0) and (XScaleRatio>Integer(FDDraw.DriverCaps.dwMaxOverlayStretch)) then
12690
      and (XScaleRatio > Integer(FDDraw.DriverCaps.dwMaxOverlayStretch))
-
 
12691
    then
6975
    begin
12692
    begin
6976
      DestRect.Right := DestRect.Left + (Integer(FSurface.SurfaceDesc.dwWidth) * (Integer(FDDraw.DriverCaps.dwMaxOverlayStretch) + 999)) div 1000;
12693
      DestRect.Right := DestRect.Left + (Integer(FSurface.SurfaceDesc.dwWidth) * (Integer(FDDraw.DriverCaps.dwMaxOverlayStretch) + 999)) div 1000;
6977
    end;
12694
    end;
6978
 
12695
 
6979
    if (FDDraw.DriverCaps.dwCaps and DDCAPS_OVERLAYSTRETCH<>0) and
12696
    if (FDDraw.DriverCaps.dwCaps and DDCAPS_OVERLAYSTRETCH <> 0)
-
 
12697
      and (FDDraw.DriverCaps.dwMinOverlayStretch <> 0)
6980
      (FDDraw.DriverCaps.dwMinOverlayStretch<>0) and (YScaleRatio<Integer(FDDraw.DriverCaps.dwMinOverlayStretch)) then
12698
      and (YScaleRatio < Integer(FDDraw.DriverCaps.dwMinOverlayStretch))
-
 
12699
    then
6981
    begin
12700
    begin
6982
      DestRect.Bottom := DestRect.Top + (Integer(FSurface.SurfaceDesc.dwHeight) * (Integer(FDDraw.DriverCaps.dwMinOverlayStretch) + 1)) div 1000;
12701
      DestRect.Bottom := DestRect.Top + (Integer(FSurface.SurfaceDesc.dwHeight) * (Integer(FDDraw.DriverCaps.dwMinOverlayStretch) + 1)) div 1000;
6983
    end;
12702
    end;
6984
 
12703
 
6985
    if (FDDraw.DriverCaps.dwCaps and DDCAPS_OVERLAYSTRETCH<>0) and
12704
    if (FDDraw.DriverCaps.dwCaps and DDCAPS_OVERLAYSTRETCH <> 0)
-
 
12705
      and (FDDraw.DriverCaps.dwMaxOverlayStretch <> 0)
6986
      (FDDraw.DriverCaps.dwMaxOverlayStretch<>0) and (YScaleRatio>Integer(FDDraw.DriverCaps.dwMaxOverlayStretch)) then
12706
      and (YScaleRatio > Integer(FDDraw.DriverCaps.dwMaxOverlayStretch))
-
 
12707
    then
6987
    begin
12708
    begin
6988
      DestRect.Bottom := DestRect.Top + (Integer(FSurface.SurfaceDesc.dwHeight) * (Integer(FDDraw.DriverCaps.dwMaxOverlayStretch) + 999)) div 1000;
12709
      DestRect.Bottom := DestRect.Top + (Integer(FSurface.SurfaceDesc.dwHeight) * (Integer(FDDraw.DriverCaps.dwMaxOverlayStretch) + 999)) div 1000;
6989
    end;
12710
    end;
6990
 
12711
 
6991
    {  Clipping at forwarding destination  }
12712
    {  Clipping at forwarding destination  }
Line 7015... Line 12736...
7015
      SrcRect.Bottom := Integer(FSurface.SurfaceDesc.dwHeight) - ((DestRect.Bottom - Integer(FTargetSurface.SurfaceDesc.dwHeight)) * 1000 div YScaleRatio);
12736
      SrcRect.Bottom := Integer(FSurface.SurfaceDesc.dwHeight) - ((DestRect.Bottom - Integer(FTargetSurface.SurfaceDesc.dwHeight)) * 1000 div YScaleRatio);
7016
      DestRect.Bottom := FTargetSurface.SurfaceDesc.dwHeight;
12737
      DestRect.Bottom := FTargetSurface.SurfaceDesc.dwHeight;
7017
    end;
12738
    end;
7018
 
12739
 
7019
    {  Forwarding former arrangement  }
12740
    {  Forwarding former arrangement  }
7020
    if (FDDraw.DriverCaps.dwCaps and DDCAPS_ALIGNBOUNDARYSRC<>0) and (FDDraw.DriverCaps.dwAlignBoundarySrc<>0) then
12741
    if (FDDraw.DriverCaps.dwCaps and DDCAPS_ALIGNBOUNDARYSRC <> 0) and (FDDraw.DriverCaps.dwAlignBoundarySrc <> 0) then
7021
    begin
12742
    begin
7022
      SrcRect.Left := (SrcRect.Left + Integer(FDDraw.DriverCaps.dwAlignBoundarySrc) div 2) div
12743
      SrcRect.Left := (SrcRect.Left + Integer(FDDraw.DriverCaps.dwAlignBoundarySrc) div 2) div
7023
        Integer(FDDraw.DriverCaps.dwAlignBoundarySrc)*Integer(FDDraw.DriverCaps.dwAlignBoundarySrc);
12744
        Integer(FDDraw.DriverCaps.dwAlignBoundarySrc) * Integer(FDDraw.DriverCaps.dwAlignBoundarySrc);
7024
    end;
12745
    end;
7025
 
12746
 
7026
    if (FDDraw.DriverCaps.dwCaps and DDCAPS_ALIGNSIZESRC<>0) and (FDDraw.DriverCaps.dwAlignSizeSrc<>0) then
12747
    if (FDDraw.DriverCaps.dwCaps and DDCAPS_ALIGNSIZESRC <> 0) and (FDDraw.DriverCaps.dwAlignSizeSrc <> 0) then
7027
    begin
12748
    begin
7028
      SrcRect.Right := SrcRect.Left + (SrcRect.Right - SrcRect.Left + Integer(FDDraw.DriverCaps.dwAlignSizeSrc) div 2) div
12749
      SrcRect.Right := SrcRect.Left + (SrcRect.Right - SrcRect.Left + Integer(FDDraw.DriverCaps.dwAlignSizeSrc) div 2) div
7029
        Integer(FDDraw.DriverCaps.dwAlignSizeSrc)*Integer(FDDraw.DriverCaps.dwAlignSizeSrc);
12750
        Integer(FDDraw.DriverCaps.dwAlignSizeSrc) * Integer(FDDraw.DriverCaps.dwAlignSizeSrc);
7030
    end;
12751
    end;
7031
 
12752
 
7032
    {  Forwarding destination arrangement  }
12753
    {  Forwarding destination arrangement  }
7033
    if (FDDraw.DriverCaps.dwCaps and DDCAPS_ALIGNBOUNDARYDEST<>0) and (FDDraw.DriverCaps.dwAlignBoundaryDest<>0) then
12754
    if (FDDraw.DriverCaps.dwCaps and DDCAPS_ALIGNBOUNDARYDEST <> 0) and (FDDraw.DriverCaps.dwAlignBoundaryDest <> 0) then
7034
    begin
12755
    begin
7035
      DestRect.Left := (DestRect.Left + Integer(FDDraw.DriverCaps.dwAlignBoundaryDest) div 2) div
12756
      DestRect.Left := (DestRect.Left + Integer(FDDraw.DriverCaps.dwAlignBoundaryDest) div 2) div
7036
        Integer(FDDraw.DriverCaps.dwAlignBoundaryDest)*Integer(FDDraw.DriverCaps.dwAlignBoundaryDest);
12757
        Integer(FDDraw.DriverCaps.dwAlignBoundaryDest) * Integer(FDDraw.DriverCaps.dwAlignBoundaryDest);
7037
    end;
12758
    end;
7038
 
12759
 
7039
    if (FDDraw.DriverCaps.dwCaps and DDCAPS_ALIGNSIZEDEST<>0) and (FDDraw.DriverCaps.dwAlignSizeDest<>0) then
12760
    if (FDDraw.DriverCaps.dwCaps and DDCAPS_ALIGNSIZEDEST <> 0) and (FDDraw.DriverCaps.dwAlignSizeDest <> 0) then
7040
    begin
12761
    begin
7041
      DestRect.Right := DestRect.Left + (DestRect.Right - DestRect.Left) div
12762
      DestRect.Right := DestRect.Left + (DestRect.Right - DestRect.Left) div
7042
        Integer(FDDraw.DriverCaps.dwAlignSizeDest)*Integer(FDDraw.DriverCaps.dwAlignSizeDest);
12763
        Integer(FDDraw.DriverCaps.dwAlignSizeDest) * Integer(FDDraw.DriverCaps.dwAlignSizeDest);
7043
    end;
12764
    end;
7044
 
12765
 
7045
    {  Color key setting  }
12766
    {  Color key setting  }
7046
    if FDDraw.DriverCaps.dwCKeyCaps and DDCKEYCAPS_DESTOVERLAY<>0 then
12767
    if FDDraw.DriverCaps.dwCKeyCaps and DDCKEYCAPS_DESTOVERLAY <> 0 then
7047
    begin
12768
    begin
7048
      OverlayFX.dckDestColorkey.dwColorSpaceLowValue := FTargetSurface.ColorMatch(FOverlayColorKey);
12769
      OverlayFX.dckDestColorkey.dwColorSpaceLowValue := FTargetSurface.ColorMatch(FOverlayColorKey);
7049
      OverlayFX.dckDestColorkey.dwColorSpaceHighValue := OverlayFX.dckDestColorkey.dwColorSpaceLowValue;
12770
      OverlayFX.dckDestColorkey.dwColorSpaceHighValue := OverlayFX.dckDestColorkey.dwColorSpaceLowValue;
7050
 
12771
 
7051
      OverlayFlags := OverlayFlags or (DDOVER_KEYDESTOVERRIDE or DDOVER_DDFX);
12772
      OverlayFlags := OverlayFlags or (DDOVER_KEYDESTOVERRIDE or DDOVER_DDFX);
7052
    end;
12773
    end;
7053
 
12774
 
7054
    FSurface.ISurface.UpdateOverlay(SrcRect, FTargetSurface.ISurface, DestRect, OverlayFlags, OverlayFX);
12775
    FSurface.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}.UpdateOverlay(@SrcRect, FTargetSurface.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, @DestRect, OverlayFlags, @OverlayFX);
7055
  end;
12776
  end;
7056
end;
12777
end;
7057
 
12778
 
7058
procedure TDirectDrawOverlay.SetVisible(Value: Boolean);
12779
procedure TDirectDrawOverlay.SetVisible(Value: Boolean);
7059
begin
12780
begin
7060
  FVisible := False;
12781
  FVisible := False;
7061
  if FSurface<>nil then
12782
  if FSurface <> nil then
7062
  begin
12783
  begin
7063
    if FVisible then
12784
    if FVisible then
7064
      SetOverlayRect(FOverlayRect)
12785
      SetOverlayRect(FOverlayRect)
7065
    else
12786
    else
-
 
12787
      FSurface.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}.UpdateOverlay(PRect(nil), FTargetSurface.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, PRect(nil), DDOVER_HIDE, PDDOverlayFX(nil));
-
 
12788
  end;
-
 
12789
end;
-
 
12790
 
-
 
12791
{ TDXFont }
-
 
12792
 
-
 
12793
constructor TDXFont.Create(AOwner: TComponent);
-
 
12794
begin
-
 
12795
  inherited Create(AOwner);
-
 
12796
end;
-
 
12797
 
-
 
12798
destructor TDXFont.Destroy;
-
 
12799
begin
-
 
12800
  inherited Destroy;
-
 
12801
end;
-
 
12802
 
-
 
12803
procedure TDXFont.Notification(AComponent: TComponent; Operation: TOperation);
-
 
12804
begin
-
 
12805
  inherited Notification(AComponent, Operation);
-
 
12806
  if (Operation = opRemove) and (AComponent = FDXImageList) then
-
 
12807
  begin
-
 
12808
    FDXImageList := nil;
-
 
12809
  end;
-
 
12810
end; {Notification}
-
 
12811
 
-
 
12812
procedure TDXFont.SetFont(const Value: string);
-
 
12813
begin
-
 
12814
  FFont := Value;
-
 
12815
  if assigned(FDXImageList) then
-
 
12816
  begin
-
 
12817
    FFontIndex := FDXImageList.items.IndexOf(FFont); { find font once }
-
 
12818
    fOffset := FDXImageList.Items[FFontIndex].PatternWidth;
-
 
12819
  end;
-
 
12820
end;
-
 
12821
 
-
 
12822
procedure TDXFont.SetFontIndex(const Value: Integer);
-
 
12823
begin
-
 
12824
  FFontIndex := Value;
-
 
12825
  if assigned(FDXImageList) then
-
 
12826
  begin
-
 
12827
    FFont := FDXImageList.Items[FFontIndex].Name;
-
 
12828
    fOffset := FDXImageList.Items[FFontIndex].PatternWidth;
-
 
12829
  end;
-
 
12830
end;
-
 
12831
 
-
 
12832
procedure TDXFont.TextOut(DirectDrawSurface: TDirectDrawSurface; X, Y: Integer; const Text: string);
-
 
12833
var
-
 
12834
  loop, letter: Integer;
-
 
12835
  UpperText: string;
-
 
12836
begin
-
 
12837
  if not assigned(FDXImageList) then
-
 
12838
    exit;
-
 
12839
  Offset := FDXImageList.Items[FFontIndex].PatternWidth;
-
 
12840
  UpperText := AnsiUppercase(text);
-
 
12841
  for loop := 1 to Length(UpperText) do
-
 
12842
  begin
-
 
12843
    letter := AnsiPos(UpperText[loop], Alphabet) - 1;
-
 
12844
    if letter < 0 then letter := 30;
-
 
12845
    FDXImageList.items[FFontIndex].Draw(DirectDrawSurface, x + Offset * loop, y, letter);
-
 
12846
  end; { loop }
-
 
12847
end;
-
 
12848
 
-
 
12849
{ TDXPowerFontEffectsParameters }
-
 
12850
 
-
 
12851
procedure TDXPowerFontEffectsParameters.SetAlphaValue(
-
 
12852
  const Value: Integer);
-
 
12853
begin
-
 
12854
  FAlphaValue := Value;
-
 
12855
end;
-
 
12856
 
-
 
12857
procedure TDXPowerFontEffectsParameters.SetAngle(const Value: Integer);
-
 
12858
begin
-
 
12859
  FAngle := Value;
-
 
12860
end;
-
 
12861
 
-
 
12862
procedure TDXPowerFontEffectsParameters.SetCenterX(const Value: Integer);
-
 
12863
begin
-
 
12864
  FCenterX := Value;
-
 
12865
end;
-
 
12866
 
-
 
12867
procedure TDXPowerFontEffectsParameters.SetCenterY(const Value: Integer);
-
 
12868
begin
-
 
12869
  FCenterY := Value;
-
 
12870
end;
-
 
12871
 
-
 
12872
procedure TDXPowerFontEffectsParameters.SetHeight(const Value: Integer);
-
 
12873
begin
-
 
12874
  FHeight := Value;
-
 
12875
end;
-
 
12876
 
-
 
12877
procedure TDXPowerFontEffectsParameters.SetWAmplitude(
-
 
12878
  const Value: Integer);
-
 
12879
begin
-
 
12880
  FWAmplitude := Value;
-
 
12881
end;
-
 
12882
 
-
 
12883
procedure TDXPowerFontEffectsParameters.SetWidth(const Value: Integer);
-
 
12884
begin
-
 
12885
  FWidth := Value;
-
 
12886
end;
-
 
12887
 
-
 
12888
procedure TDXPowerFontEffectsParameters.SetWLenght(const Value: Integer);
-
 
12889
begin
-
 
12890
  FWLenght := Value;
-
 
12891
end;
-
 
12892
 
-
 
12893
procedure TDXPowerFontEffectsParameters.SetWPhase(const Value: Integer);
-
 
12894
begin
-
 
12895
  FWPhase := Value;
-
 
12896
end;
-
 
12897
 
-
 
12898
{ TDXPowerFont }
-
 
12899
 
-
 
12900
constructor TDXPowerFont.Create(AOwner: TComponent);
-
 
12901
begin
-
 
12902
  inherited Create(AOwner);
-
 
12903
  FUseEnterChar := True;
-
 
12904
  FEnterCharacter := '|<';
-
 
12905
  FAlphabets := PowerAlphaBet;
-
 
12906
  FTextOutType := ttNormal;
-
 
12907
  FTextOutEffect := teNormal;
-
 
12908
  FEffectsParameters := TDXPowerFontEffectsParameters.Create;
-
 
12909
end;
-
 
12910
 
-
 
12911
destructor TDXPowerFont.Destroy;
-
 
12912
begin
-
 
12913
  inherited Destroy;
-
 
12914
end;
-
 
12915
 
-
 
12916
procedure TDXPowerFont.SetAlphabets(const Value: string);
-
 
12917
begin
-
 
12918
  if FDXImageList <> nil then
-
 
12919
    if Length(Value) > FDXImageList.Items[FFontIndex].PatternCount - 1 then Exit;
-
 
12920
  FAlphabets := Value;
-
 
12921
end;
-
 
12922
 
-
 
12923
procedure TDXPowerFont.SetEnterCharacter(const Value: string);
-
 
12924
begin
-
 
12925
  if Length(Value) >= 2 then Exit;
-
 
12926
  FEnterCharacter := Value;
-
 
12927
end;
-
 
12928
 
-
 
12929
procedure TDXPowerFont.SetFont(const Value: string);
-
 
12930
begin
-
 
12931
  FFont := Value;
-
 
12932
  if FDXImageList <> nil then
-
 
12933
  begin
-
 
12934
    FFontIndex := FDXImageList.Items.IndexOf(FFont); // Find font once...
-
 
12935
    Offset := FDXImageList.Items[FFontIndex].PatternWidth;
-
 
12936
 
-
 
12937
    FEffectsParameters.Width := FDXImageList.Items[FFontIndex].PatternWidth;
-
 
12938
    FEffectsParameters.Height := FDXImageList.Items[FFontIndex].PatternHeight;
-
 
12939
  end;
-
 
12940
end;
-
 
12941
 
-
 
12942
procedure TDXPowerFont.SetFontIndex(const Value: Integer);
-
 
12943
begin
-
 
12944
  FFontIndex := Value;
-
 
12945
  if FDXImageList <> nil then
-
 
12946
  begin
-
 
12947
    FFont := FDXImageList.Items[FFontIndex].Name;
-
 
12948
    Offset := FDXImageList.Items[FFontIndex].PatternWidth;
-
 
12949
 
-
 
12950
    FEffectsParameters.Width := FDXImageList.Items[FFontIndex].PatternWidth;
-
 
12951
    FEffectsParameters.Height := FDXImageList.Items[FFontIndex].PatternHeight;
-
 
12952
  end;
-
 
12953
end;
-
 
12954
 
-
 
12955
procedure TDXPowerFont.SetEffectsParameters(const Value: TDXPowerFontEffectsParameters);
-
 
12956
begin
-
 
12957
  FEffectsParameters := Value;
-
 
12958
end;
-
 
12959
 
-
 
12960
procedure TDXPowerFont.SetTextOutEffect(const Value: TDXPowerFontTextOutEffect);
-
 
12961
begin
-
 
12962
  FTextOutEffect := Value;
-
 
12963
end;
-
 
12964
 
-
 
12965
procedure TDXPowerFont.SetTextOutType(const Value: TDXPowerFontTextOutType);
-
 
12966
begin
-
 
12967
  FTextOutType := Value;
-
 
12968
end;
-
 
12969
 
-
 
12970
procedure TDXPowerFont.SetUseEnterChar(const Value: Boolean);
-
 
12971
begin
-
 
12972
  FUseEnterChar := Value;
-
 
12973
end;
-
 
12974
 
-
 
12975
function TDXPowerFont.TextOutFast(DirectDrawSurface: TDirectDrawSurface; X, Y: Integer; const Text: string): Boolean;
-
 
12976
var
-
 
12977
  Loop, Letter: Integer;
-
 
12978
  txt: string;
-
 
12979
begin
-
 
12980
  Result := False;
-
 
12981
  if FDXImageList = nil then Exit;
-
 
12982
        // modified
-
 
12983
  case FTextOutType of
-
 
12984
    ttNormal: Txt := Text;
-
 
12985
    ttUpperCase: Txt := AnsiUpperCase(Text);
-
 
12986
    ttLowerCase: Txt := AnsiLowerCase(Text);
-
 
12987
  end;
-
 
12988
  Offset := FDXImageList.Items[FFontIndex].PatternWidth;
-
 
12989
  Loop := 1;
-
 
12990
  while (Loop <= Length(Text)) do
-
 
12991
  begin
-
 
12992
    Letter := AnsiPos(txt[Loop], FAlphabets); // modified
-
 
12993
    if (Letter > 0) and (Letter < FDXImageList.Items[FFontIndex].PatternCount - 1) then
-
 
12994
      FDXImageList.Items[FFontIndex].Draw(DirectDrawSurface, X + (Offset * Loop), Y, Letter - 1);
-
 
12995
    Inc(Loop);
-
 
12996
  end;
-
 
12997
  Result := True;
-
 
12998
end;
-
 
12999
 
-
 
13000
function TDXPowerFont.TextOut(DirectDrawSurface: TDirectDrawSurface; X, Y: Integer; const Text: string): Boolean;
-
 
13001
var
-
 
13002
  Loop, Letter: Integer;
-
 
13003
  FCalculatedEnters, EnterHeghit, XLoop: Integer;
-
 
13004
  DoTextOut: Boolean;
-
 
13005
  Txt: string;
-
 
13006
  Rect: TRect;
-
 
13007
begin
-
 
13008
  Result := False;
-
 
13009
  if FDXImageList = nil then Exit;
-
 
13010
  Txt := Text;
-
 
13011
  DoTextOut := True;
-
 
13012
  if Assigned(FBeforeTextOut) then FBeforeTextOut(Self, Txt, DoTextOut);
-
 
13013
  if not DoTextOut then Exit;
-
 
13014
  // modified
-
 
13015
  case FTextOutType of
-
 
13016
    ttNormal: Txt := Text;
-
 
13017
    ttUpperCase: Txt := AnsiUpperCase(Text);
-
 
13018
    ttLowerCase: Txt := AnsiLowerCase(Text);
-
 
13019
  end;
-
 
13020
  Offset := FDXImageList.Items[FFontIndex].PatternWidth;
-
 
13021
  FCalculatedEnters := 0;
-
 
13022
  EnterHeghit := FDXImageList.Items[FFontIndex].PatternHeight;
-
 
13023
  XLoop := 0;
-
 
13024
  Loop := 1;
-
 
13025
  while (Loop <= Length(Txt)) do
-
 
13026
  begin
-
 
13027
    if FUseEnterChar then
-
 
13028
    begin
-
 
13029
      if Txt[Loop] = FEnterCharacter[1] then begin Inc(FCalculatedEnters); Inc(Loop); end;
-
 
13030
      if Txt[Loop] = FEnterCharacter[2] then begin Inc(FCalculatedEnters); XLoop := 0; {-FCalculatedEnters;} Inc(Loop); end;
-
 
13031
    end;
-
 
13032
    Letter := AnsiPos(Txt[Loop], FAlphabets); // modified
-
 
13033
 
-
 
13034
    if (Letter > 0) and (Letter < FDXImageList.Items[FFontIndex].PatternCount - 1) then
-
 
13035
      case FTextOutEffect of
-
 
13036
        teNormal: FDXImageList.Items[FFontIndex].Draw(DirectDrawSurface, X + (Offset * XLoop), Y + (FCalculatedEnters * EnterHeghit), Letter - 1);
-
 
13037
        teRotat: FDXImageList.Items[FFontIndex].DrawRotate(DirectDrawSurface, X + (Offset * XLoop), Y + (FCalculatedEnters * EnterHeghit), FEffectsParameters.Width, FEffectsParameters.Height, Letter - 1, FEffectsParameters.CenterX, FEffectsParameters.CenterY, FEffectsParameters.Angle);
-
 
13038
        teAlphaBlend:
-
 
13039
          begin
-
 
13040
            Rect.Left := X + (Offset * XLoop);
-
 
13041
            Rect.Top := Y + (FCalculatedEnters * EnterHeghit);
-
 
13042
            Rect.Right := Rect.Left + FEffectsParameters.Width;
-
 
13043
            Rect.Bottom := Rect.Top + FEffectsParameters.Height;
-
 
13044
 
-
 
13045
            FDXImageList.Items[FFontIndex].DrawAlpha(DirectDrawSurface, Rect, Letter - 1, FEffectsParameters.AlphaValue);
-
 
13046
          end;
7066
      FSurface.ISurface.UpdateOverlay(PRect(nil)^, FTargetSurface.ISurface, PRect(nil)^, DDOVER_HIDE, PDDOverlayFX(nil)^);
13047
        teWaveX: FDXImageList.Items[FFontIndex].DrawWaveX(DirectDrawSurface, X + (Offset * XLoop), Y + (FCalculatedEnters * EnterHeghit), FEffectsParameters.Width, FEffectsParameters.Height, Letter - 1, FEffectsParameters.WAmplitude, FEffectsParameters.WLenght, FEffectsParameters.WPhase);
-
 
13048
      end;
-
 
13049
    Inc(Loop);
-
 
13050
    Inc(XLoop);
-
 
13051
  end;
-
 
13052
  if Assigned(FAfterTextOut) then FAfterTextOut(Self, Txt);
-
 
13053
  Result := True;
-
 
13054
end;
-
 
13055
 
-
 
13056
//---------------------------------------------------------------------------
-
 
13057
{
-
 
13058
Main code supported hardware acceleration by videoadapteur
-
 
13059
 *  Copyright (c) 2004-2010 Jaro Benes
-
 
13060
 *  All Rights Reserved
-
 
13061
 *  Version 1.09
-
 
13062
 *  D2D Hardware module - main implementation part
-
 
13063
 *  web site: www.micrel.cz/Dx
-
 
13064
 *  e-mail: delphix_d2d@micrel.cz
-
 
13065
}
-
 
13066
 
-
 
13067
constructor TD2DTextures.Create(DDraw: TCustomDXDraw);
-
 
13068
begin
-
 
13069
  //inherited;
-
 
13070
  FDDraw := DDraw; //reload DDraw
-
 
13071
{$IFNDEF VER4UP}
-
 
13072
  TexLen := 0;
-
 
13073
  Texture := nil;
-
 
13074
{$ELSE}
-
 
13075
  SetLength(Texture, 0);
-
 
13076
{$ENDIF}
-
 
13077
end;
-
 
13078
 
-
 
13079
destructor TD2DTextures.Destroy;
-
 
13080
var
-
 
13081
  I: Integer;
-
 
13082
begin
-
 
13083
  if Assigned(Texture) then
-
 
13084
    {$IFDEF VER4UP}
-
 
13085
    for I := Low(Texture) to High(Texture) do
-
 
13086
    begin
-
 
13087
      Texture[I].D2DTexture.Free;
-
 
13088
      {$IFDEF VIDEOTEX}
-
 
13089
      if Assigned(Texture[I].VDIB) then
-
 
13090
        Texture[I].VDIB.Free;
-
 
13091
      {$ENDIF}
-
 
13092
    end;
-
 
13093
    {$ELSE}
-
 
13094
    for I := 0 to TexLen - 1 do
-
 
13095
    begin
-
 
13096
      Texture[I].D2DTexture.Free;
-
 
13097
      {$IFDEF VIDEOTEX}
-
 
13098
      if Assigned(Texture[I].VDIB) then
-
 
13099
        Texture[I].VDIB.Free;
-
 
13100
      {$ENDIF}
-
 
13101
    end;
-
 
13102
    {$ENDIF}
-
 
13103
  inherited;
-
 
13104
end;
-
 
13105
 
-
 
13106
function TD2DTextures.GetD2DMaxTextures: Integer;
-
 
13107
begin
-
 
13108
  Result := {$IFDEF VER4UP}Length(Texture){$ELSE}TexLen{$ENDIF};
-
 
13109
end;
-
 
13110
 
-
 
13111
procedure TD2DTextures.SaveTextures(path: string);
-
 
13112
var I: Integer;
-
 
13113
begin
-
 
13114
  if Texture <> nil then
-
 
13115
    {$IFDEF VER4UP}
-
 
13116
    if Length(Texture) > 0 then
-
 
13117
      for I := Low(Texture) to High(Texture) do
-
 
13118
    {$ELSE}
-
 
13119
    if TexLen > 0 then
-
 
13120
      for I := 0 to TexLen - 1 do
-
 
13121
    {$ENDIF}
-
 
13122
        Texture[I].D2DTexture.FImage.SaveToFile(path + Texture[I].Name + '.dxt');
-
 
13123
end;
-
 
13124
 
-
 
13125
procedure TD2DTextures.SetD2DMaxTextures(const Value: Integer);
-
 
13126
begin
-
 
13127
  if Value > 0 then
-
 
13128
  {$IFDEF VER4UP}
-
 
13129
    SetLength(Texture, Value)
-
 
13130
  {$ELSE}
-
 
13131
    Inc(TexLen);
-
 
13132
  if Texture = nil then
-
 
13133
    Texture := AllocMem(SizeOf(TTextureRec))
-
 
13134
  else begin
-
 
13135
      {alokuj pamet}
-
 
13136
    ReallocMem(Texture, TexLen * SizeOf(TTextureRec));
-
 
13137
  end;
-
 
13138
  {$ENDIF}
-
 
13139
end;
-
 
13140
 
-
 
13141
function TD2DTextures.Find(byName: string): Integer;
-
 
13142
var I: Integer;
-
 
13143
begin
-
 
13144
  Result := -1;
-
 
13145
  if Texture <> nil then
-
 
13146
    {$IFDEF VER4UP}
-
 
13147
    if Length(Texture) > 0 then
-
 
13148
      for I := Low(Texture) to High(Texture) do
-
 
13149
        if AnsiUpperCase(Texture[I].Name) = AnsiUpperCase(byName) then
-
 
13150
        begin
-
 
13151
          Result := I;
-
 
13152
          Exit;
-
 
13153
        end;
-
 
13154
    {$ELSE}
-
 
13155
    if TexLen > 0 then
-
 
13156
      for I := 0 to TexLen - 1 do
-
 
13157
        if AnsiUpperCase(Texture[I].Name) = AnsiUpperCase(byName) then
-
 
13158
        begin
-
 
13159
          Result := I;
-
 
13160
          Exit;
-
 
13161
        end;
-
 
13162
    {$ENDIF}
-
 
13163
end;
-
 
13164
 
-
 
13165
function TD2DTextures.GetTextureByName(const byName: string): TDirect3DTexture2;
-
 
13166
begin
-
 
13167
  Result := nil;
-
 
13168
  if Assigned(Texture) then
-
 
13169
    Result := Texture[Find(byName)].D2DTexture;
-
 
13170
end;
-
 
13171
 
-
 
13172
function TD2DTextures.GetTextureByIndex(const byIndex: Integer): TDirect3DTexture2;
-
 
13173
begin
-
 
13174
  Result := nil;
-
 
13175
  {$IFNDEF VER4UP}
-
 
13176
  if Assigned(Texture) and (byIndex >= 0) and (byIndex <= (TexLen - 1)) then
-
 
13177
    Result := Texture[byIndex].D2DTexture;
-
 
13178
  {$ELSE}
-
 
13179
  if Assigned(Texture) and (byIndex in [0..High(Texture)]) then
-
 
13180
    Result := Texture[byIndex].D2DTexture;
-
 
13181
  {$ENDIF}
-
 
13182
end;
-
 
13183
 
-
 
13184
function TD2DTextures.GetTextureNameByIndex(const byIndex: Integer): string;
-
 
13185
begin
-
 
13186
  Result := '';
-
 
13187
  {$IFNDEF VER4UP}
-
 
13188
  if Assigned(Texture) and (byIndex >= 0) and (byIndex <= (TexLen - 1)) then
-
 
13189
    Result := Texture[byIndex].Name;
-
 
13190
  {$ELSE}
-
 
13191
  if Assigned(Texture) and (byIndex in [0..High(Texture)]) then
-
 
13192
    Result := Texture[byIndex].Name;
-
 
13193
  {$ENDIF}
-
 
13194
end;
-
 
13195
 
-
 
13196
function TD2DTextures.Count: Integer;
-
 
13197
begin
-
 
13198
  Result := 0;
-
 
13199
  if Assigned(Texture) then
-
 
13200
  {$IFNDEF VER4UP}
-
 
13201
    Result := TexLen;
-
 
13202
  {$ELSE}
-
 
13203
    Result := High(Texture) + 1;
-
 
13204
  {$ENDIF}
-
 
13205
end;
-
 
13206
 
-
 
13207
procedure TD2DTextures.D2DPruneAllTextures;
-
 
13208
var I: Integer;
-
 
13209
begin
-
 
13210
  if not Assigned(Texture) then Exit;
-
 
13211
  {$IFDEF VER4UP}
-
 
13212
  for I := Low(Texture) to High(Texture) do
-
 
13213
  {$ELSE}
-
 
13214
  for I := 0 to TexLen - 1 do
-
 
13215
  {$ENDIF}
-
 
13216
  begin
-
 
13217
    Texture[I].D2DTexture.Free;
-
 
13218
    {$IFDEF VIDEOTEX}
-
 
13219
    if Assigned(Texture[I].VDIB) then
-
 
13220
      Texture[I].VDIB.Free;
-
 
13221
    {$ENDIF}
-
 
13222
  end;
-
 
13223
  {$IFDEF VER4UP}
-
 
13224
  SetLength(Texture, 0);
-
 
13225
  {$ELSE}
-
 
13226
  TexLen := 0;
-
 
13227
  {$ENDIF}
-
 
13228
end;
-
 
13229
 
-
 
13230
procedure TD2DTextures.D2DFreeTextures;
-
 
13231
var I: Integer;
-
 
13232
begin
-
 
13233
  if not Assigned(Texture) then Exit;
-
 
13234
  {$IFDEF VER4UP}
-
 
13235
  for I := Low(Texture) to High(Texture) do
-
 
13236
  {$ELSE}
-
 
13237
  for I := 0 to TexLen - 1 do
-
 
13238
  {$ENDIF}
-
 
13239
  begin
-
 
13240
    Texture[I].D2DTexture.Free;
-
 
13241
    {$IFDEF VIDEOTEX}
-
 
13242
    if Assigned(Texture[I].VDIB) then
-
 
13243
      Texture[I].VDIB.Free;
-
 
13244
    {$ENDIF}  
-
 
13245
  end;
-
 
13246
  {$IFNDEF VER4UP}
-
 
13247
  FreeMem(Texture, TexLen * SizeOf(TTextureRec));
-
 
13248
  Texture := nil;
-
 
13249
  {$ENDIF}
-
 
13250
end;
-
 
13251
 
-
 
13252
procedure TD2DTextures.D2DPruneTextures;
-
 
13253
begin
-
 
13254
  if {$IFDEF VER4UP}Length(Texture){$ELSE}TexLen{$ENDIF} > maxTexBlock then
-
 
13255
  begin
-
 
13256
    D2DPruneAllTextures
-
 
13257
  end;
-
 
13258
end;
-
 
13259
 
-
 
13260
procedure TD2DTextures.SizeAdjust(var DIB: TDIB; var FloatX1, FloatY1, FloatX2, FloatY2: Double);
-
 
13261
var
-
 
13262
  X, Y: Integer;
-
 
13263
  tempDIB: TDIB;
-
 
13264
begin {auto-adjust size n^2 for accelerator compatibility}
-
 
13265
  X := 1;
-
 
13266
  repeat
-
 
13267
    X := X * 2;
-
 
13268
  until DIB.Width <= X;
-
 
13269
  Y := 1;
-
 
13270
  repeat
-
 
13271
    Y := Y * 2
-
 
13272
  until DIB.Height <= Y;
-
 
13273
  {$IFDEF FORCE_SQUARE}
-
 
13274
  X := Max(X, Y);
-
 
13275
  Y := X;
-
 
13276
  {$ENDIF}
-
 
13277
  if (X = DIB.Width) and (Y = DIB.Height) then
-
 
13278
  begin
-
 
13279
    if DIB.BitCount = 32 then Exit; {do not touch}
-
 
13280
    {code for correction a DIB.BitCount to 24 bit only}
-
 
13281
    tempDIB := TDIB.Create;
-
 
13282
    try
-
 
13283
      tempDIB.SetSize(X, Y, 24);
-
 
13284
      FillChar(tempDIB.PBits^, tempDIB.Size, 0);
-
 
13285
      tempDIB.Canvas.Draw(0, 0, DIB);
-
 
13286
      DIB.Assign(tempDIB);
-
 
13287
    finally
-
 
13288
      tempDIB.Free;
-
 
13289
    end;
-
 
13290
    Exit;
-
 
13291
  end;
-
 
13292
  tempDIB := TDIB.Create;
-
 
13293
  try
-
 
13294
    if DIB.BitCount = 32 then
-
 
13295
    begin
-
 
13296
      tempDIB.SetSize(X, Y, 32);
-
 
13297
      FillChar(tempDIB.PBits^, tempDIB.Size, 0);
-
 
13298
      //tempDIB.Canvas.Brush.Color := clBlack;
-
 
13299
      //tempDIB.Canvas.FillRect(Bounds(0, 0, X, Y));
-
 
13300
      tempDIB.Canvas.Draw(0, 0, DIB);
-
 
13301
//      if DIB.HasAlphaChannel then
-
 
13302
//        tempDIB.AssignAlphaChannel(DIB);
-
 
13303
    end
-
 
13304
    else
-
 
13305
    begin
-
 
13306
      tempDIB.SetSize(X, Y, 24 {DIB.BitCount}); {bad value for some 16}
-
 
13307
      FillChar(tempDIB.PBits^, tempDIB.Size, 0);
-
 
13308
      //tempDIB.Canvas.Brush.Color := clBlack;
-
 
13309
      //tempDIB.Canvas.FillRect(Bounds(0, 0, X, Y));
-
 
13310
      tempDIB.Canvas.Draw(0, 0, DIB);
-
 
13311
    end;
-
 
13312
    FloatX2 := (1 / tempDIB.Width) * DIB.Width;
-
 
13313
    FloatY2 := (1 / tempDIB.Height) * DIB.Height;
-
 
13314
    DIB.Assign(tempDIB);
-
 
13315
  finally
-
 
13316
    tempDIB.Free;
-
 
13317
  end
-
 
13318
end;
-
 
13319
 
-
 
13320
function TD2DTextures.CanFindTexture(aImage: TPictureCollectionItem): Boolean;
-
 
13321
var I: Integer;
-
 
13322
begin
-
 
13323
  Result := True;
-
 
13324
  {$IFDEF VER4UP}
-
 
13325
  if Length(Texture) > 0 then
-
 
13326
  {$ELSE}
-
 
13327
  if TexLen > 0 then
-
 
13328
  {$ENDIF}
-
 
13329
    for I := 0 to D2DMaxTextures - 1 do
-
 
13330
      if Texture[I].Name = aImage.Name then Exit;
-
 
13331
  Result := False;
-
 
13332
end;
-
 
13333
 
-
 
13334
function TD2DTextures.LoadTextures(aImage: TPictureCollectionItem): Boolean;
-
 
13335
var
-
 
13336
  {$IFNDEF VIDEOTEX}
-
 
13337
  VDIB: TDIB;
-
 
13338
  {$ENDIF}
-
 
13339
  T: TDXTextureImage;
-
 
13340
begin
-
 
13341
  Result := True;
-
 
13342
  try
-
 
13343
    D2DPruneTextures; {up to maxTexBlock textures only}
-
 
13344
    D2DMaxTextures := D2DMaxTextures + 1;
-
 
13345
    if aImage.Name = '' then // FIX: OPTIMIZED
-
 
13346
      aImage.Name := aImage.GetNamePath; {this name is supplement name, when wasn't aImage.Name fill}
-
 
13347
    {$IFDEF VIDEOTEX}Texture[D2DMaxTextures - 1].{$ENDIF}VDIB := TDIB.Create;
-
 
13348
    try
-
 
13349
    with Texture[D2DMaxTextures - 1] do
-
 
13350
    begin
-
 
13351
      VDIB.Assign(aImage.Picture.Graphic);
-
 
13352
      VDIB.Transparent := aImage.Transparent;
-
 
13353
      FloatX1 := 0; FloatY1 := 0; FloatX2 := 1; FloatY2 := 1;
-
 
13354
      SizeAdjust(VDIB, FloatX1, FloatY1, FloatX2, FloatY2);
-
 
13355
      Name := aImage.Name;
-
 
13356
      Width := VDIB.Width;
-
 
13357
      Height := VDIB.Height;
-
 
13358
      if VDIB.HasAlphaChannel then
-
 
13359
      begin
-
 
13360
        DIB2DXT(VDIB, T);
-
 
13361
        T.ImageName := aImage.Name;
-
 
13362
        T.Transparent := aImage.Transparent;
-
 
13363
        D2DTexture := TDirect3DTexture2.Create(FDDraw, T, False);
-
 
13364
        D2DTexture.Transparent := aImage.Transparent;
-
 
13365
        AlphaChannel := True;
-
 
13366
        //**T.Free; DO NOT FREE - surface is lost ** FIX by JB.
-
 
13367
      end
-
 
13368
      else
-
 
13369
      begin
-
 
13370
        D2DTexture := TDirect3DTexture2.Create(FDDraw, VDIB, False);
-
 
13371
        D2DTexture.TransparentColor := DWORD(aImage.TransparentColor);
-
 
13372
        D2DTexture.Surface.TransparentColor := DWORD(aImage.TransparentColor);
-
 
13373
        D2DTexture.Transparent := aImage.Transparent;
-
 
13374
        AlphaChannel := False;
-
 
13375
      end;
-
 
13376
    end;
-
 
13377
    finally
-
 
13378
      {$IFNDEF VIDEOTEX}
-
 
13379
      VDIB.Free;
-
 
13380
      {$ENDIF}
-
 
13381
    end;
-
 
13382
  except
-
 
13383
    D2DMaxTextures := D2DMaxTextures - 1;
-
 
13384
    Result := False;
-
 
13385
  end;
-
 
13386
end;
-
 
13387
 
-
 
13388
{$IFDEF VER4UP}
-
 
13389
function TD2DTextures.CanFindTexture(const TexName: string): Boolean;
-
 
13390
{$ELSE}
-
 
13391
function TD2DTextures.CanFindTexture2(const TexName: string): Boolean;
-
 
13392
{$ENDIF}
-
 
13393
var I: Integer;
-
 
13394
begin
-
 
13395
  Result := True;
-
 
13396
{$IFDEF VER4UP}
-
 
13397
  if Length(Texture) > 0 then
-
 
13398
{$ELSE}
-
 
13399
  if TexLen > 0 then
-
 
13400
{$ENDIF}
-
 
13401
    for I := 0 to D2DMaxTextures - 1 do
-
 
13402
      if Texture[I].Name = TexName then Exit;
-
 
13403
  Result := False;
-
 
13404
end;
-
 
13405
 
-
 
13406
function TD2DTextures.SetTransparentColor(dds: TDirectDrawSurface; PixelColor: Integer; Transparent: Boolean): Integer;
-
 
13407
{Give a speculative transparent color value from DDS}
-
 
13408
var
-
 
13409
  ddck: TDDColorKey;
-
 
13410
  CLL: Integer;
-
 
13411
begin
-
 
13412
  Result := 0;
-
 
13413
  if dds.{$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF} <> nil then
-
 
13414
    if dds.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}.GetColorKey(DDCKEY_SRCBLT, ddck) = DD_OK then
-
 
13415
      Result := ddck.dwColorSpaceLowValue;
-
 
13416
  CLL := PixelColor; {have to pick up color from 0,0 pix of DIB}
-
 
13417
  if Transparent then {and must be transparent}
-
 
13418
    if (CLL <> Result) then {when different}
-
 
13419
      Result := CLL; {use our TransparentColor}
-
 
13420
end;
-
 
13421
 
-
 
13422
{$IFDEF VER4UP}
-
 
13423
function TD2DTextures.LoadTextures(dds: TDirectDrawSurface; Transparent: Boolean; asTexName: string): Boolean;
-
 
13424
{$ELSE}
-
 
13425
function TD2DTextures.LoadTextures2(dds: TDirectDrawSurface; Transparent: Boolean; asTexName: string): Boolean;
-
 
13426
{$ENDIF}
-
 
13427
var
-
 
13428
  {$IFNDEF VIDEOTEX}
-
 
13429
  VDIB: TDIB;
-
 
13430
  {$ENDIF}
-
 
13431
  Col: Integer;
-
 
13432
  T: PTextureRec;
-
 
13433
begin
-
 
13434
  Result := True;
-
 
13435
  T := nil;
-
 
13436
  try
-
 
13437
    if dds.Modified then
-
 
13438
    begin
-
 
13439
      {search existing texture and return the pointer}
-
 
13440
      T := Addr(Texture[Find(asTexName)]);
-
 
13441
      {$IFNDEF VIDEOTEX}VDIB := TDIB.Create;{$ENDIF}
-
 
13442
    end
-
 
13443
    else
-
 
13444
    begin
-
 
13445
      D2DPruneTextures; {up to maxTexBlock textures only}
-
 
13446
      D2DMaxTextures := D2DMaxTextures + 1; {next to new space}
-
 
13447
      T := Addr(Texture[D2DMaxTextures - 1]); {is new place}
-
 
13448
      {set name}
-
 
13449
      T.Name := asTexName;
-
 
13450
      {and create video-dib object for store the picture periodically changed}
-
 
13451
      {$IFDEF VIDEOTEX}T.{$ENDIF}VDIB := TDIB.Create;
-
 
13452
      //T.VDIB.PixelFormat := MakeDIBPixelFormat(8, 8, 8);
-
 
13453
    end;
-
 
13454
    try
-
 
13455
      {the dds assigned here}
-
 
13456
      {$IFDEF VIDEOTEX}T.{$ENDIF}VDIB.Assign(dds);
-
 
13457
      {with full adjustation}
-
 
13458
      T.FloatX1 := 0; T.FloatY1 := 0; T.FloatX2 := 1; T.FloatY2 := 1;
-
 
13459
      SizeAdjust({$IFDEF VIDEOTEX}T.{$ENDIF}VDIB, T.FloatX1, T.FloatY1, T.FloatX2, T.FloatY2);
-
 
13460
      {and store 'changed' values of size here}
-
 
13461
      T.Width := {$IFDEF VIDEOTEX}T.{$ENDIF}VDIB.Width;
-
 
13462
      T.Height := {$IFDEF VIDEOTEX}T.{$ENDIF}VDIB.Height;
-
 
13463
      {and it have to set by dds as transparent, when it set up}
-
 
13464
      {$IFDEF VIDEOTEX}T.{$ENDIF}VDIB.Transparent := Transparent;
-
 
13465
      {get up transparent color}
-
 
13466
      Col := SetTransparentColor(dds, {$IFDEF VIDEOTEX}T.{$ENDIF}VDIB.Pixels[0, 0], Transparent);
-
 
13467
      if dds.Modified then
-
 
13468
        T.D2DTexture.Load {for minimize time only load as videotexture}
-
 
13469
      else
-
 
13470
        T.D2DTexture := TDirect3DTexture2.Create(FDDraw, {$IFDEF VIDEOTEX}T.{$ENDIF}VDIB, False); {create it}
-
 
13471
      {don't forget set transparent values on texture!}
-
 
13472
      T.D2DTexture.TransparentColor := DWORD(COL);
-
 
13473
      T.D2DTexture.Surface.TransparentColor := DWORD(COL);
-
 
13474
      T.D2DTexture.Transparent := Transparent;
-
 
13475
    finally
-
 
13476
     {$IFNDEF VIDEOTEX}
-
 
13477
      if Assigned(VDIB) then VDIB.Free;
-
 
13478
     {$ENDIF}
-
 
13479
    end;
-
 
13480
  except
-
 
13481
    {eh, sorry, when is not the dds modified, roll back and release last the VDIB}
-
 
13482
    if not dds.Modified then
-
 
13483
      if T <> nil then
-
 
13484
      begin
-
 
13485
        if Assigned({$IFDEF VIDEOTEX}T.{$ENDIF}VDIB) then
-
 
13486
        {$IFNDEF D5UP}
-
 
13487
        begin {$IFDEF VIDEOTEX}T.{$ENDIF}VDIB.Free; {$IFDEF VIDEOTEX}T.{$ENDIF}VDIB := nil; end;
-
 
13488
        {$ELSE}
-
 
13489
          FreeAndNil({$IFDEF VIDEOTEX}T.{$ENDIF}VDIB);
-
 
13490
        {$ENDIF}
-
 
13491
        if Assigned(T.D2DTexture) then
-
 
13492
        {$IFNDEF D5UP}
-
 
13493
        begin T.D2DTexture.Free; T.D2DTexture := nil; end;
-
 
13494
        {$ELSE}
-
 
13495
          FreeAndNil(T.D2DTexture);
-
 
13496
        {$ENDIF}
-
 
13497
 
-
 
13498
        D2DMaxTextures := D2DMaxTextures - 1; //go back
-
 
13499
      end;
-
 
13500
    Result := False;
-
 
13501
  end;
-
 
13502
  dds.Modified := False; {this flag turn off always}
-
 
13503
end;
-
 
13504
 
-
 
13505
{$IFDEF VER4UP}
-
 
13506
function TD2DTextures.LoadTextures(dds: TDirectDrawSurface; Transparent: Boolean;
-
 
13507
  TransparentColor: Integer; asTexName: string): Boolean;
-
 
13508
{$ELSE}
-
 
13509
function TD2DTextures.LoadTextures3(dds: TDirectDrawSurface; Transparent: Boolean;
-
 
13510
  TransparentColor: Integer; asTexName: string): Boolean;
-
 
13511
{$ENDIF}
-
 
13512
  function getDDSTransparentColor(DIB: TDIB; dds: TDirectDrawSurface): Integer;
-
 
13513
  var CLL: Integer; ddck: TDDColorKey;
-
 
13514
  begin
-
 
13515
    Result := 0;
-
 
13516
    if dds.{$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF} <> nil then
-
 
13517
      if dds.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}.GetColorKey(DDCKEY_SRCBLT, ddck) = DD_OK then
-
 
13518
        Result := ddck.dwColorSpaceLowValue;
-
 
13519
    CLL := TransparentColor;
-
 
13520
    if (CLL = -1) or (cardinal(CLL) <> DIB.Pixels[0, 0]) then //when is DDS
-
 
13521
      CLL := DIB.Pixels[0, 0]; //have to pick up color from 0,0 pix of DIB
-
 
13522
    if Transparent then //and must be transparent
-
 
13523
      if CLL <> Result then //when different
-
 
13524
        Result := CLL; //use TransparentColor
-
 
13525
  end;
-
 
13526
var
-
 
13527
  {$IFNDEF VIDEOTEX}
-
 
13528
  VDIB: TDIB;
-
 
13529
  {$ENDIF}
-
 
13530
  COL: Integer;
-
 
13531
  T: TDXTextureImage;
-
 
13532
begin
-
 
13533
  Result := True;
-
 
13534
  try
-
 
13535
    D2DPruneTextures; {up to maxTexBlock textures only}
-
 
13536
    D2DMaxTextures := D2DMaxTextures + 1;
-
 
13537
    Texture[D2DMaxTextures - 1].Name := asTexName;
-
 
13538
    {$IFDEF VIDEOTEX}Texture[D2DMaxTextures - 1].{$ENDIF}VDIB := TDIB.Create;
-
 
13539
    try
-
 
13540
    with Texture[D2DMaxTextures - 1] do
-
 
13541
    begin
-
 
13542
      VDIB.AsSign(dds);
-
 
13543
      VDIB.Transparent := Transparent;
-
 
13544
      FloatX1 := 0; FloatY1 := 0; FloatX2 := 1; FloatY2 := 1;
-
 
13545
      SizeAdjust(VDIB, FloatX1, FloatY1, FloatX2, FloatY2);
-
 
13546
      Width := VDIB.Width;
-
 
13547
      Height := VDIB.Height;
-
 
13548
      if VDIB.HasAlphaChannel then
-
 
13549
      begin
-
 
13550
        DIB2DXT(VDIB, T);
-
 
13551
        T.ImageName := asTexName;
-
 
13552
        T.Transparent := Transparent;
-
 
13553
        D2DTexture := TDirect3DTexture2.Create(FDDraw, T, False);
-
 
13554
        D2DTexture.Transparent := Transparent;
-
 
13555
        AlphaChannel := True;
-
 
13556
        //**T.Free; DO NOT FREE - surface is lost ** FIX by JB.
-
 
13557
      end
-
 
13558
      else
-
 
13559
      begin
-
 
13560
        D2DTexture := TDirect3DTexture2.Create(FDDraw, VDIB, False);
-
 
13561
        if transparentcolor = -1 then
-
 
13562
          COL := getDDSTransparentColor(VDIB, DDS)
-
 
13563
        else
-
 
13564
          COL := D2DTexture.Surface.ColorMatch(transparentcolor);
-
 
13565
          D2DTexture.TransparentColor := DWORD(COL); //**
-
 
13566
          D2DTexture.Surface.TransparentColor := DWORD(COL); //**
-
 
13567
          D2DTexture.Transparent := Transparent;
-
 
13568
          AlphaChannel := False;
-
 
13569
      end;
-
 
13570
    end
-
 
13571
    finally
-
 
13572
      {$IFNDEF VIDEOTEX}
-
 
13573
      VDIB.Free;
-
 
13574
      {$ENDIF}
-
 
13575
    end;
-
 
13576
  except
-
 
13577
    D2DMaxTextures := D2DMaxTextures - 1;
-
 
13578
    Result := False;
-
 
13579
  end;
-
 
13580
end;
-
 
13581
 
-
 
13582
{$IFDEF VER4UP}
-
 
13583
function TD2DTextures.CanFindTexture(const Color: LongInt): Boolean;
-
 
13584
{$ELSE}
-
 
13585
function TD2DTextures.CanFindTexture3(const Color: LongInt): Boolean;
-
 
13586
{$ENDIF}
-
 
13587
var I: Integer;
-
 
13588
begin
-
 
13589
  Result := True;
-
 
13590
  {$IFDEF VER4UP}
-
 
13591
  if Length(Texture) > 0 then
-
 
13592
  {$ELSE}
-
 
13593
  if TexLen > 0 then
-
 
13594
  {$ENDIF}
-
 
13595
    for I := 0 to D2DMaxTextures - 1 do
-
 
13596
      if Texture[I].Name = '$' + IntToStr(Color) then Exit;
-
 
13597
  Result := False;
-
 
13598
end;
-
 
13599
 
-
 
13600
{$IFDEF VER4UP}
-
 
13601
function TD2DTextures.LoadTextures(Color: LongInt): Boolean;
-
 
13602
{$ELSE}
-
 
13603
function TD2DTextures.LoadTextures4(Color: LongInt): Boolean;
-
 
13604
{$ENDIF}
-
 
13605
var
-
 
13606
  S: string;
-
 
13607
  {$IFNDEF VIDEOTEX}
-
 
13608
  VDIB: TDIB;
-
 
13609
  {$ENDIF}
-
 
13610
begin
-
 
13611
  Result := True;
-
 
13612
  try
-
 
13613
    D2DPruneTextures; {up to maxTexBlock textures only}
-
 
13614
    D2DMaxTextures := D2DMaxTextures + 1;
-
 
13615
    S := '$' + IntToStr(Color); {this name is supplement name}
-
 
13616
    {$IFDEF VIDEOTEX}Texture[D2DMaxTextures - 1].{$ENDIF}VDIB := TDIB.Create;
-
 
13617
    try
-
 
13618
    with Texture[D2DMaxTextures - 1] do
-
 
13619
    begin
-
 
13620
      VDIB.SetSize(16, 16, 24); {16x16 good size}
-
 
13621
      VDIB.Canvas.Brush.Color := Color;
-
 
13622
      VDIB.Canvas.FillRect(Bounds(0, 0, 16, 16));
-
 
13623
 
-
 
13624
      FloatX1 := 0;
-
 
13625
      FloatY1 := 0;
-
 
13626
      FloatX2 := 1;
-
 
13627
      FloatY2 := 1;
-
 
13628
      Name := S;
-
 
13629
      D2DTexture := TDirect3DTexture2.Create(FDDraw, VDIB, False);
-
 
13630
      D2DTexture.Transparent := False; //cannot be transparent
-
 
13631
    end;
-
 
13632
    finally
-
 
13633
      {$IFNDEF VIDEOTEX}
-
 
13634
      VDIB.Free;
-
 
13635
      {$ENDIF}
-
 
13636
    end;
-
 
13637
  except
-
 
13638
    D2DMaxTextures := D2DMaxTextures - 1;
-
 
13639
    Result := False;
-
 
13640
  end;
-
 
13641
end;
-
 
13642
 
-
 
13643
{$IFDEF VIDEOTEX}
-
 
13644
function TD2DTextures.GetTexLayoutByName(name: string): TDIB;
-
 
13645
var
-
 
13646
  I: Integer;
-
 
13647
begin
-
 
13648
  Result := nil;
-
 
13649
  I := Find(name);
-
 
13650
  {$IFDEF VER4UP}
-
 
13651
  if (I >= Low(Texture)) and (I <= High(Texture)) then
-
 
13652
  {$ELSE}
-
 
13653
  if I <> -1 then
-
 
13654
  {$ENDIF}
-
 
13655
    Result := Texture[I].VDIB
-
 
13656
end;
-
 
13657
{$ENDIF}
-
 
13658
 
-
 
13659
//---------------------------------------------------------------------------
-
 
13660
 
-
 
13661
constructor TD2D.Create(DDraw: TCustomDXDraw);
-
 
13662
begin
-
 
13663
  inherited Create;
-
 
13664
  //after inheritance
-
 
13665
  FDDraw := DDraw;
-
 
13666
  FD2DTextureFilter := D2D_POINT {D2D_LINEAR};
-
 
13667
  {$IFNDEF D3D_deprecated}
-
 
13668
  FD2DTexture := TD2DTextures.Create(FDDraw);
-
 
13669
  {$ENDIF}
-
 
13670
  InitVertex;
-
 
13671
  {internal allocation of texture}
-
 
13672
  CanUseD2D := {$IFDEF D3D_deprecated}(do3D in FDDraw.Options) and
-
 
13673
    (doDirectX7Mode in FDDraw.Options) and
-
 
13674
    (doHardware in FDDraw.Options){$ELSE}True{$ENDIF};
-
 
13675
  FDIB := TDIB.Create;
-
 
13676
  FInitialized := False;
-
 
13677
end;
-
 
13678
 
-
 
13679
destructor TD2D.Destroy;
-
 
13680
begin
-
 
13681
  {freeing texture and stop using it}
-
 
13682
  CanUseD2D := False;
-
 
13683
  if AsSigned(FD2DTexture) then
-
 
13684
  begin
-
 
13685
    FD2DTexture.Free; {add 29.5.2005 Takanori Kawasaki}
-
 
13686
    FD2DTexture := nil;
-
 
13687
  end;
-
 
13688
  FDIB.Free;
-
 
13689
  inherited Destroy;
-
 
13690
end;
-
 
13691
 
-
 
13692
procedure TD2D.InitVertex;
-
 
13693
var i: Integer;
-
 
13694
begin
-
 
13695
  Fillchar(FVertex, SizeOf(FVertex), 0);
-
 
13696
  for i := 0 to 3 do
-
 
13697
  begin
-
 
13698
    FVertex[i].Specular := D3DRGB(1.0, 1.0, 1.0);
-
 
13699
    FVertex[i].rhw := 1.0;
-
 
13700
  end;
-
 
13701
end;
-
 
13702
 
-
 
13703
//---------------------------------------------------------------------------
-
 
13704
 
-
 
13705
procedure TD2D.BeginScene();
-
 
13706
begin
-
 
13707
  asm
-
 
13708
    FINIT
-
 
13709
  end;
-
 
13710
  FDDraw.D3DDevice7.BeginScene();
-
 
13711
  asm
-
 
13712
    FINIT
-
 
13713
  end;
-
 
13714
  FDDraw.D3DDevice7.Clear(0, nil, D3DCLEAR_TARGET, 0, 0, 0);
-
 
13715
end;
-
 
13716
 
-
 
13717
//---------------------------------------------------------------------------
-
 
13718
 
-
 
13719
procedure TD2D.EndScene();
-
 
13720
begin
-
 
13721
  asm
-
 
13722
    FINIT
-
 
13723
  end;
-
 
13724
  FDDraw.D3DDevice7.EndScene();
-
 
13725
  asm
-
 
13726
    FINIT
-
 
13727
  end;
-
 
13728
end;
-
 
13729
 
-
 
13730
function TD2D.D2DTexturedOn(Image: TPictureCollectionItem; Pattern: Integer; SubPatternRect: TRect; RenderType: TRenderType; Alpha: Byte): Boolean;
-
 
13731
var I: Integer;
-
 
13732
  SrcX, SrcY, diffX: Double;
-
 
13733
  R: TRect;
-
 
13734
  Q: TTextureRec;
-
 
13735
begin
-
 
13736
  Result := False;
-
 
13737
  FDDraw.D3DDevice7.SetTexture(0, nil);
-
 
13738
  if not FD2DTexture.CanFindTexture(Image) then {when no texture in list try load it}
-
 
13739
    if not FD2DTexture.LoadTextures(Image) then {loading is here}
-
 
13740
      Exit; {on error occurr out}
-
 
13741
  I := FD2DTexture.Find(Image.Name);
-
 
13742
  if I = -1 then Exit;
-
 
13743
  {set pattern as texture}
-
 
13744
//  FDDraw.D3DDevice7.SetTextureStageState(0, D3DTSS_MAGFILTER, DWord(Ord(FD2DTextureFilter)+1));
-
 
13745
//  FDDraw.D3DDevice7.SetTextureStageState(0, D3DTSS_MINFILTER, DWord(Ord(FD2DTextureFilter)+1));
-
 
13746
  try
-
 
13747
    RenderError := FDDraw.D3DDevice7.SetTexture(0, FD2DTexture.Texture[I].D2DTexture.Surface.IDDSurface7) <> DD_OK;
-
 
13748
    case RenderType of
-
 
13749
      rtDraw: begin D2DEffectSolid; D2DWhite; end;
-
 
13750
      rtBlend: begin D2DEffectBlend; D2DAlphaVertex(Alpha); end;
-
 
13751
      rtAdd: begin D2DEffectAdd; D2DFade(Alpha); end;
-
 
13752
      rtSub: begin D2DEffectSub; D2DFade(Alpha); end;
-
 
13753
    end;
-
 
13754
  except
-
 
13755
    RenderError := True;
-
 
13756
    FD2DTexture.D2DPruneAllTextures;
-
 
13757
    Image.Restore;
-
 
13758
    SetD2DTextureFilter(D2D_LINEAR);
-
 
13759
    Exit;
-
 
13760
  end;
-
 
13761
  {set transparent area}
-
 
13762
  RenderError := FDDraw.D3DDevice7.SetRenderState(D3DRENDERSTATE_COLORKEYENABLE, Ord(FD2DTexture.Texture[I].D2DTexture.Transparent)) <> DD_OK;
-
 
13763
  {except for Draw when alphachannel exists}
-
 
13764
  {change for blend drawing but save transparent area still}
-
 
13765
  if FD2DTexture.Texture[I].AlphaChannel then
-
 
13766
    {when is Draw selected then}
-
 
13767
    if RenderType = rtDraw then
-
 
13768
    begin
-
 
13769
      D2DEffectBlend;
-
 
13770
      D2DAlphaVertex($FF);
-
 
13771
    end;
-
 
13772
  {pokud je obrazek rozdeleny, nastav oka site}
-
 
13773
  if (Image.PatternHeight <> 0) or (Image.PatternWidth <> 0) then
-
 
13774
  begin
-
 
13775
    {vezmi rect jenom dilku}
-
 
13776
    R := Image.PatternRects[Pattern];
-
 
13777
    SrcX := 1 / FD2DTexture.Texture[I].Width;
-
 
13778
    SrcY := 1 / FD2DTexture.Texture[I].Height;
-
 
13779
    //namapovani vertexu na texturu
-
 
13780
    FD2DTexture.Texture[I].FloatX1 := SrcX * R.Left;
-
 
13781
    FD2DTexture.Texture[I].FloatY1 := SrcY * R.Top;
-
 
13782
    {for meshed subimage contain one image only can be problem there}
-
 
13783
    diffX := 0.5; if Image.PatternCount = 1 then diffX := 0;
-
 
13784
    FD2DTexture.Texture[I].FloatX2 := SrcX * (R.Right - diffX);
-
 
13785
    FD2DTexture.Texture[I].FloatY2 := SrcY * (R.Bottom - diffX);
-
 
13786
    if not (
-
 
13787
      (SubPatternRect.Left = Image.PatternRects[Pattern].Left) and
-
 
13788
      (SubPatternRect.Top = Image.PatternRects[Pattern].Top) and
-
 
13789
      (SubPatternRect.Right = Image.PatternRects[Pattern].Right) and
-
 
13790
      (SubPatternRect.Bottom = Image.PatternRects[Pattern].Bottom))
-
 
13791
    then
-
 
13792
    begin
-
 
13793
      {remaping subtexture via subpattern}
-
 
13794
      Q.FloatX1 := SrcX * SubPatternRect.Left;
-
 
13795
      Q.FloatY1 := SrcY * SubPatternRect.Top;
-
 
13796
      Q.FloatX2 := SrcX * (SubPatternRect.Right - diffX);
-
 
13797
      Q.FloatY2 := SrcY * (SubPatternRect.Bottom - diffX);
-
 
13798
      D2DTU(Q); {with mirroring/flipping}
-
 
13799
      Result := not RenderError;
-
 
13800
      Exit;
-
 
13801
    end;
-
 
13802
  end; {jinak celeho obrazku}
-
 
13803
 
-
 
13804
  {  X1,Y1             X2,Y1
-
 
13805
  0  +-----------------+  1
-
 
13806
     |                 |
-
 
13807
     |                 |
-
 
13808
     |                 |
-
 
13809
     |                 |
-
 
13810
  2  +-----------------+  3
-
 
13811
     X1,Y2             X2,Y2  }
-
 
13812
  D2DTU(FD2DTexture.Texture[I]);
-
 
13813
  Result := not RenderError;
-
 
13814
end;
-
 
13815
 
-
 
13816
function TD2D.D2DTexturedOnDDSTex(dds: TDirectDrawSurface; SubPatternRect: TRect; Transparent: Boolean): Integer;
-
 
13817
{special version of map for TDirectDrawSurface only}
-
 
13818
{set up transparent color from this surface}
-
 
13819
var
-
 
13820
  TexName: string;
-
 
13821
begin
-
 
13822
  Result := -1;
-
 
13823
  {pokud je seznam prazdny, nahrej texturu}
-
 
13824
  if dds.Caption <> '' then TexName := dds.Caption
-
 
13825
  else TexName := IntToStr(Integer(dds)); {simple but stupid}
-
 
13826
  if not FD2DTexture.{$IFDEF VER4UP}CanFindTexture{$ELSE}CanFindTexture2{$ENDIF}(TexName) then
-
 
13827
  begin
-
 
13828
    {when texture doesn't exists, has to the Modified flag turn off}
-
 
13829
    if dds.Modified then
-
 
13830
      dds.Modified := not dds.Modified;
-
 
13831
    if not FD2DTexture.{$IFDEF VER4UP}LoadTextures{$ELSE}LoadTextures2{$ENDIF}(dds, Transparent, TexName) then
-
 
13832
      Exit; {nepovede-li se to, pak ven}
-
 
13833
  end
-
 
13834
  else
-
 
13835
    if dds.Modified then
-
 
13836
    begin {when modifying, load texture allways}
-
 
13837
      if not FD2DTexture.{$IFDEF VER4UP}LoadTextures{$ELSE}LoadTextures2{$ENDIF}(dds, Transparent, TexName) then
-
 
13838
        Exit; {nepovede-li se to, pak ven}
-
 
13839
    end;
-
 
13840
  Result := FD2DTexture.Find(TexName);
-
 
13841
end;
-
 
13842
 
-
 
13843
function IsNotZero(Z: TRect): Boolean;
-
 
13844
begin
-
 
13845
  Result := ((Z.Right - Z.Left) > 0) and ((Z.Bottom - Z.Top) > 0)
-
 
13846
end;
-
 
13847
 
-
 
13848
function TD2D.D2DTexturedOnDDS(dds: TDirectDrawSurface; SubPatternRect: TRect; Transparent: Boolean; RenderType: TRenderType; Alpha: Byte): Boolean;
-
 
13849
var I: Integer;
-
 
13850
  SrcX, SrcY: Double;
-
 
13851
begin
-
 
13852
  Result := False;
-
 
13853
  FDDraw.D3DDevice7.SetTexture(0, nil);
-
 
13854
  {call a low level routine for load DDS texture}
-
 
13855
  I := D2DTexturedOnDDSTex(dds, SubPatternRect, Transparent);
-
 
13856
  if I = -1 then Exit;
-
 
13857
  {set pattern as texture}
-
 
13858
//  FDDraw.D3DDevice7.SetTextureStageState(0, D3DTSS_MAGFILTER, DWord(Ord(FD2DTextureFilter)+1));
-
 
13859
//  FDDraw.D3DDevice7.SetTextureStageState(0, D3DTSS_MINFILTER, DWord(Ord(FD2DTextureFilter)+1));
-
 
13860
  try
-
 
13861
    RenderError := FDDraw.D3DDevice7.SetTexture(0, FD2DTexture.Texture[I].D2DTexture.Surface.IDDSurface7) <> DD_OK;
-
 
13862
    case RenderType of
-
 
13863
      rtDraw: begin D2DEffectSolid; D2DWhite; end;
-
 
13864
      rtBlend: begin D2DEffectBlend; D2DAlphaVertex(Alpha); end;
-
 
13865
      rtAdd: begin D2DEffectAdd; D2DFade(Alpha); end;
-
 
13866
      rtSub: begin D2DEffectSub; D2DFade(Alpha); end;
-
 
13867
    end;
-
 
13868
  except
-
 
13869
    RenderError := True;
-
 
13870
    FD2DTexture.D2DPruneAllTextures;
-
 
13871
    SetD2DTextureFilter(D2D_LINEAR); //default
-
 
13872
    Exit;
-
 
13873
  end;
-
 
13874
  {set transparent area}
-
 
13875
  RenderError := FDDraw.D3DDevice7.SetRenderState(D3DRENDERSTATE_COLORKEYENABLE, Ord(FD2DTexture.Texture[I].D2DTexture.Transparent)) <> DD_OK;
-
 
13876
  if IsNotZero(SubPatternRect) then
-
 
13877
  begin
-
 
13878
    {Set Texture Coordinates}
-
 
13879
    SrcX := 1 / FD2DTexture.Texture[I].D2DTexture.FImage.Width;
-
 
13880
    SrcY := 1 / FD2DTexture.Texture[I].D2DTexture.FImage.Height;
-
 
13881
    //namapovani vertexu na texturu
-
 
13882
    FD2DTexture.Texture[I].FloatX1 := SrcX * SubPatternRect.Left;
-
 
13883
    FD2DTexture.Texture[I].FloatY1 := SrcY * SubPatternRect.Top;
-
 
13884
    FD2DTexture.Texture[I].FloatX2 := SrcX * (SubPatternRect.Right - 0.5 { - 1}); //by Speeeder
-
 
13885
    FD2DTexture.Texture[I].FloatY2 := SrcY * (SubPatternRect.Bottom - 0.5 { - 1}); //by Speeeder
-
 
13886
  end;
-
 
13887
  D2DTU(FD2DTexture.Texture[I]);
-
 
13888
  Result := not RenderError;
-
 
13889
end;
-
 
13890
 
-
 
13891
//---------------------------------------------------------------------------
-
 
13892
 
-
 
13893
procedure TD2D.SaveTextures(path: string);
-
 
13894
begin
-
 
13895
  FD2DTexture.SaveTextures(path);
-
 
13896
end;
-
 
13897
 
-
 
13898
procedure TD2D.SetCanUseD2D(const Value: Boolean);
-
 
13899
begin
-
 
13900
  case Value of
-
 
13901
    False: {prestava se uzivat}
-
 
13902
      if AsSigned(FD2DTexture) and (Value <> FCanUseD2D) then
-
 
13903
      begin
-
 
13904
        FInitialized := False;
-
 
13905
      end;
-
 
13906
    True:
-
 
13907
      if Value <> FCanUseD2D then
-
 
13908
      begin
-
 
13909
        {$IFDEF D3D_deprecated}
-
 
13910
        FD2DTexture := TD2DTextures.Create(FDDraw);
-
 
13911
        TextureFilter := D2D_LINEAR;
-
 
13912
        {$ENDIF}
-
 
13913
      end
-
 
13914
  end;
-
 
13915
  FCanUseD2D := Value;
-
 
13916
end;
-
 
13917
 
-
 
13918
function TD2D.GetCanUseD2D: Boolean;
-
 
13919
begin
-
 
13920
  {$IFDEF D3D_deprecated}
-
 
13921
  {Mode has to do3D, doDirectX7Mode and doHardware}
-
 
13922
  if (do3D in FDDraw.Options) and
-
 
13923
    (doDirectX7Mode in FDDraw.Options) and
-
 
13924
    (doHardware in FDDraw.Options)
-
 
13925
  then
-
 
13926
  begin
-
 
13927
    if not FCanUseD2D then CanUseD2D := True;
-
 
13928
  end
-
 
13929
  else
-
 
13930
    if not (do3D in FDDraw.Options) or
-
 
13931
      not (doDirectX7Mode in FDDraw.Options) or
-
 
13932
      not (doHardware in FDDraw.Options)
-
 
13933
      then
-
 
13934
      if FCanUseD2D then FCanUseD2D := False; // CanUseD2D -> FCanUseD2D
-
 
13935
  {$ELSE}
-
 
13936
  FCanUseD2D := (doHardware in FDDraw.Options);
-
 
13937
  {$ENDIF}
-
 
13938
  FBitCount := FDDraw.Surface.SurfaceDesc.ddpfPixelFormat.dwRGBBitCount;
-
 
13939
  {supported 16 or 32 bitcount deepth only}
-
 
13940
  {$IFDEF D3D_deprecated}
-
 
13941
  if not (FBitCount in [16, 32]) then FCanUseD2D := False;
-
 
13942
  {$ENDIF}
-
 
13943
  if not FInitialized then
-
 
13944
    if FCanUseD2D and Assigned(FDDraw.D3DDevice7) then
-
 
13945
    begin
-
 
13946
      FDDraw.D3DDevice7.GetCaps(FD3DDevDesc7);
-
 
13947
      FInitialized := True;
-
 
13948
    end;
-
 
13949
 
-
 
13950
  Result := FCanUseD2D;
-
 
13951
end;
-
 
13952
 
-
 
13953
procedure TD2D.SetD2DTextureFilter(const Value: TD2DTextureFilter);
-
 
13954
begin
-
 
13955
  FD2DTextureFilter := Value;
-
 
13956
  if {$IFDEF D3D_deprecated}(do3D in FDDraw.Options) and{$ENDIF} AsSigned(FDDraw.D3DDevice7) then
-
 
13957
  begin
-
 
13958
    FDDraw.D3DDevice7.SetTextureStageState(0, D3DTSS_MAGFILTER, DWord(Ord(FD2DTextureFilter) + 1));
-
 
13959
    FDDraw.D3DDevice7.SetTextureStageState(0, D3DTSS_MINFILTER, DWord(Ord(FD2DTextureFilter) + 1));
-
 
13960
  end;
-
 
13961
end;
-
 
13962
 
-
 
13963
procedure TD2D.SetD2DAntialiasFilter(const Value: TD3DAntialiasMode);
-
 
13964
begin
-
 
13965
  FD2DAntialiasFilter := Value;
-
 
13966
  if {$IFDEF D3D_deprecated}(do3D in FDDraw.Options) and{$ENDIF} AsSigned(FDDraw.D3DDevice7) then
-
 
13967
  begin
-
 
13968
    FDDraw.D3DDevice7.SetRenderState(D3DRENDERSTATE_ANTIALIAS, Ord(Value));
-
 
13969
  end;
-
 
13970
end;
-
 
13971
 
-
 
13972
procedure TD2D.D2DRect(R: TRect);
-
 
13973
begin
-
 
13974
  FVertex[0].sx := R.Left - 0.5;
-
 
13975
  FVertex[0].sy := R.Top - 0.5;
-
 
13976
  FVertex[1].sx := R.Right - 0.5;
-
 
13977
  FVertex[1].sy := R.Top - 0.5;
-
 
13978
  FVertex[2].sx := R.Left - 0.5;
-
 
13979
  FVertex[2].sy := R.Bottom - 0.5;
-
 
13980
  FVertex[3].sx := R.Right - 0.5;
-
 
13981
  FVertex[3].sy := R.Bottom - 0.5;
-
 
13982
end;
-
 
13983
 
-
 
13984
procedure TD2D.D2DTU(T: TTextureRec);
-
 
13985
begin
-
 
13986
  if FMirrorFlipSet = [rmfMirror] then
-
 
13987
  begin
-
 
13988
    {  X1,Y1             X2,Y1
-
 
13989
    0  +-----------------+  1
-
 
13990
       |                 |
-
 
13991
       |                 |
-
 
13992
       |                 |
-
 
13993
       |                 |
-
 
13994
    2  +-----------------+  3
-
 
13995
       X1,Y2             X2,Y2  }
-
 
13996
    FVertex[1].tu := T.FloatX1;
-
 
13997
    FVertex[1].tv := T.FloatY1;
-
 
13998
    FVertex[0].tu := T.FloatX2;
-
 
13999
    FVertex[0].tv := T.FloatY1;
-
 
14000
    FVertex[3].tu := T.FloatX1;
-
 
14001
    FVertex[3].tv := T.FloatY2;
-
 
14002
    FVertex[2].tu := T.FloatX2;
-
 
14003
    FVertex[2].tv := T.FloatY2;
-
 
14004
  end
-
 
14005
  else
-
 
14006
  if FMirrorFlipSet = [rmfFlip] then
-
 
14007
  begin
-
 
14008
    {  X1,Y1             X2,Y1
-
 
14009
    0  +-----------------+  1
-
 
14010
       |                 |
-
 
14011
       |                 |
-
 
14012
       |                 |
-
 
14013
       |                 |
-
 
14014
    2  +-----------------+  3
-
 
14015
       X1,Y2             X2,Y2  }
-
 
14016
    FVertex[2].tu := T.FloatX1;
-
 
14017
    FVertex[2].tv := T.FloatY1;
-
 
14018
    FVertex[3].tu := T.FloatX2;
-
 
14019
    FVertex[3].tv := T.FloatY1;
-
 
14020
    FVertex[0].tu := T.FloatX1;
-
 
14021
    FVertex[0].tv := T.FloatY2;
-
 
14022
    FVertex[1].tu := T.FloatX2;
-
 
14023
    FVertex[1].tv := T.FloatY2;
-
 
14024
  end
-
 
14025
  else
-
 
14026
  if FMirrorFlipSet = [rmfMirror, rmfFlip] then
-
 
14027
  begin
-
 
14028
    {  X1,Y1             X2,Y1
-
 
14029
    0  +-----------------+  1
-
 
14030
       |                 |
-
 
14031
       |                 |
-
 
14032
       |                 |
-
 
14033
       |                 |
-
 
14034
    2  +-----------------+  3
-
 
14035
       X1,Y2             X2,Y2  }
-
 
14036
    FVertex[3].tu := T.FloatX1;
-
 
14037
    FVertex[3].tv := T.FloatY1;
-
 
14038
    FVertex[2].tu := T.FloatX2;
-
 
14039
    FVertex[2].tv := T.FloatY1;
-
 
14040
    FVertex[1].tu := T.FloatX1;
-
 
14041
    FVertex[1].tv := T.FloatY2;
-
 
14042
    FVertex[0].tu := T.FloatX2;
-
 
14043
    FVertex[0].tv := T.FloatY2;
-
 
14044
  end
-
 
14045
  else
-
 
14046
  begin
-
 
14047
    {  X1,Y1             X2,Y1
-
 
14048
    0  +-----------------+  1
-
 
14049
       |                 |
-
 
14050
       |                 |
-
 
14051
       |                 |
-
 
14052
       |                 |
-
 
14053
    2  +-----------------+  3
-
 
14054
       X1,Y2             X2,Y2  }
-
 
14055
    FVertex[0].tu := T.FloatX1;
-
 
14056
    FVertex[0].tv := T.FloatY1;
-
 
14057
    FVertex[1].tu := T.FloatX2;
-
 
14058
    FVertex[1].tv := T.FloatY1;
-
 
14059
    FVertex[2].tu := T.FloatX1;
-
 
14060
    FVertex[2].tv := T.FloatY2;
-
 
14061
    FVertex[3].tu := T.FloatX2;
-
 
14062
    FVertex[3].tv := T.FloatY2;
-
 
14063
  end;
-
 
14064
end;
-
 
14065
 
-
 
14066
{Final public routines}
-
 
14067
 
-
 
14068
function TD2D.D2DRender(Image: TPictureCollectionItem; DestRect: TRect;
-
 
14069
  Pattern: Integer; SourceRect: TRect; RenderType: TRenderType; Alpha: Byte): Boolean;
-
 
14070
begin
-
 
14071
  Result := False; if not CanUseD2D then Exit;
-
 
14072
  if D2DTexturedOnSubRect(Image, Pattern, Image.PatternRects[Pattern], SourceRect, RenderType, Alpha) then
-
 
14073
  begin
-
 
14074
    D2DRect(DestRect);
-
 
14075
    Result := RenderQuad;
-
 
14076
  end;
-
 
14077
end;
-
 
14078
 
-
 
14079
function TD2D.{$IFNDEF VER4UP}D2DRender2{$ELSE}D2DRender{$ENDIF}(Image: TPictureCollectionItem; R: TRect;
-
 
14080
  Pattern: Integer; RenderType: TRenderType; Alpha: Byte): Boolean;
-
 
14081
begin
-
 
14082
  Result := False; if not CanUseD2D then Exit;
-
 
14083
  if D2DTexturedOn(Image, Pattern, Image.PatternRects[Pattern], RenderType, Alpha) then
-
 
14084
  begin
-
 
14085
    D2DRect(R);
-
 
14086
    Result := RenderQuad;
-
 
14087
  end;
-
 
14088
end;
-
 
14089
 
-
 
14090
function TD2D.D2DRenderDDS(Source: TDirectDrawSurface; SourceRect, DestRect: TRect;
-
 
14091
  Transparent: Boolean; Pattern: Integer; RenderType: TRenderType; Alpha: Byte): Boolean;
-
 
14092
begin
-
 
14093
  Result := False; if not CanUseD2D then Exit;
-
 
14094
  if D2DTexturedOnDDS(Source, SourceRect, Transparent, RenderType, Alpha) then
-
 
14095
  begin
-
 
14096
    D2DRect(DestRect);
-
 
14097
    Result := RenderQuad;
-
 
14098
  end;
-
 
14099
end;
-
 
14100
 
-
 
14101
function TD2D.D2DRenderCol(Image: TPictureCollectionItem; R: TRect;
-
 
14102
  Pattern, Color: Integer; RenderType: TRenderType; Alpha: Byte): Boolean;
-
 
14103
begin
-
 
14104
  Result := False; if not CanUseD2D then Exit;
-
 
14105
  if D2DTexturedOn(Image, Pattern, Image.PatternRects[Pattern], RenderType, Alpha) then
-
 
14106
  begin
-
 
14107
    D2DRect(R);
-
 
14108
    Result := RenderQuad;
-
 
14109
  end;
-
 
14110
end;
-
 
14111
 
-
 
14112
function TD2D.D2DRenderColDDS(Source: TDirectDrawSurface; SourceRect, DestRect: TRect;
-
 
14113
  Transparent: Boolean; Pattern, Color: Integer; RenderType: TRenderType; Alpha: Byte): Boolean;
-
 
14114
begin
-
 
14115
  Result := False; if not CanUseD2D then Exit;
-
 
14116
  {Add}
-
 
14117
  if D2DTexturedOnDDS(Source, SourceRect, Transparent, RenderType, Alpha) then
-
 
14118
  begin
-
 
14119
    D2DRect(DestRect);
-
 
14120
    Result := RenderQuad;
-
 
14121
  end;
-
 
14122
end;
-
 
14123
 
-
 
14124
function TD2D.D2DRenderDrawXY(Image: TPictureCollectionItem; X, Y: Integer;
-
 
14125
  Pattern: Integer; RenderType: TRenderType; Alpha: Byte): Boolean;
-
 
14126
var PWidth, PHeight: Integer;
-
 
14127
begin
-
 
14128
  Result := False; if not CanUseD2D then Exit;
-
 
14129
  {Draw}
-
 
14130
  if D2DTexturedOn(Image, Pattern, Image.PatternRects[Pattern], RenderType, Alpha) then
-
 
14131
  begin
-
 
14132
    PWidth := Image.PatternWidth; if PWidth = 0 then PWidth := Image.Width;
-
 
14133
    PHeight := Image.PatternHeight; if PHeight = 0 then PHeight := Image.Height;
-
 
14134
    D2DRect(Bounds(X, Y, PWidth, PHeight));
-
 
14135
    Result := RenderQuad;
-
 
14136
  end;
-
 
14137
end;
-
 
14138
 
-
 
14139
function TD2D.D2DRenderDrawDDSXY(Source: TDirectDrawSurface; X, Y: Integer;
-
 
14140
  Transparent: Boolean; Pattern: Integer; RenderType: TRenderType; Alpha: Byte): Boolean;
-
 
14141
begin
-
 
14142
  Result := False; if not CanUseD2D then Exit;
-
 
14143
  {Draw}
-
 
14144
  if D2DTexturedOnDDS(Source, ZeroRect, Transparent, RenderType, Alpha) then
-
 
14145
  begin
-
 
14146
    D2DRect(Bounds(X, Y, Source.Width, Source.Height));
-
 
14147
    Result := RenderQuad;
-
 
14148
  end;
-
 
14149
end;
-
 
14150
 
-
 
14151
{$IFDEF VER4UP}
-
 
14152
function TD2D.D2DRenderDrawDDSXY(Source: TDirectDrawSurface; X, Y: Integer;
-
 
14153
  SrcRect: TRect; Transparent: Boolean; Pattern: Integer; RenderType: TRenderType; Alpha: Byte): Boolean;
-
 
14154
begin
-
 
14155
  Result := False; if not CanUseD2D then Exit;
-
 
14156
  {Draw}
-
 
14157
  if D2DTexturedOnDDS(Source, SrcRect, Transparent, RenderType, Alpha) then
-
 
14158
  begin
-
 
14159
    D2DRect(Bounds(X, Y, SrcRect.Right - SrcRect.Left, SrcRect.Bottom - SrcRect.Top));
-
 
14160
    Result := RenderQuad;
-
 
14161
  end;
-
 
14162
end;
-
 
14163
{$ENDIF}
-
 
14164
 
-
 
14165
{Rotate functions}
-
 
14166
 
-
 
14167
procedure TD2D.D2DRotate(X, Y, W, H: Integer; Px, Py: Double; Angle: Single);
-
 
14168
  procedure SinCosS(const Theta: Single; var Sin, Cos: Single); register;
-
 
14169
  { EAX contains address of Sin}
-
 
14170
  { EDX contains address of Cos}
-
 
14171
  { Theta is passed over the stack}
-
 
14172
  asm
-
 
14173
    FLD  Theta
-
 
14174
    FSINCOS
-
 
14175
    FSTP DWORD PTR [EDX]    // cosine
-
 
14176
    FSTP DWORD PTR [EAX]    // sine
-
 
14177
  end;
-
 
14178
const PI256 = 2 * PI / 256;
-
 
14179
var x1, y1, up, s_angle, c_angle, s_up, c_up: Single;
-
 
14180
begin
-
 
14181
  angle := angle * PI256; up := angle + PI / 2;
-
 
14182
  x1 := w * px; y1 := h * py;
-
 
14183
  SinCosS(angle, s_angle, c_angle);
-
 
14184
  SinCosS(up, s_up, c_up);
-
 
14185
  FVertex[0].sx := X - x1 * c_angle - y1 * c_up;
-
 
14186
  FVertex[0].sy := Y - x1 * s_angle - y1 * s_up;
-
 
14187
  FVertex[1].sx := FVertex[0].sx + W * c_angle;
-
 
14188
  FVertex[1].sy := FVertex[0].sy + W * s_angle;
-
 
14189
  FVertex[2].sx := FVertex[0].sx + H * c_up;
-
 
14190
  FVertex[2].sy := FVertex[0].sy + H * s_up;
-
 
14191
  FVertex[3].sx := FVertex[2].sx + W * c_angle;
-
 
14192
  FVertex[3].sy := FVertex[2].sy + W * s_angle;
-
 
14193
end;
-
 
14194
 
-
 
14195
function TD2D.D2DRenderRotate(Image: TPictureCollectionItem; RotX, RotY,
-
 
14196
  PictWidth, PictHeight, PatternIndex: Integer; RenderType: TRenderType;
-
 
14197
  CenterX, CenterY: Double;
-
 
14198
  Angle: single; Alpha: Byte): Boolean;
-
 
14199
begin
-
 
14200
  Result := False; if not CanUseD2D then Exit;
-
 
14201
  {load textures and map it, set of effect}
-
 
14202
  if D2DTexturedOn(Image, PatternIndex, Image.PatternRects[PatternIndex], RenderType, Alpha) then
-
 
14203
  begin
-
 
14204
    {do rotate mesh}
-
 
14205
    D2DRotate(RotX, RotY, PictWidth, PictHeight, CenterX, CenterY, Angle);
-
 
14206
    {render it}
-
 
14207
    Result := RenderQuad;
-
 
14208
  end;
-
 
14209
end;
-
 
14210
 
-
 
14211
function TD2D.D2DRenderRotateDDS(Image: TDirectDrawSurface; SourceRect: TRect; RotX, RotY,
-
 
14212
  PictWidth, PictHeight: Integer; RenderType: TRenderType;
-
 
14213
  CenterX, CenterY: Double; Angle: single; Alpha: Byte;
-
 
14214
  Transparent: Boolean): Boolean;
-
 
14215
begin
-
 
14216
  Result := False; if not CanUseD2D then Exit;
-
 
14217
  {load textures and map it, set of effect}
-
 
14218
  if D2DTexturedOnDDS(Image, SourceRect, Transparent, RenderType, Alpha) then
-
 
14219
  begin
-
 
14220
    {do rotate mesh}
-
 
14221
    D2DRotate(RotX, RotY, PictWidth, PictHeight, CenterX, CenterY, Angle);
-
 
14222
    {render it}
-
 
14223
    Result := RenderQuad;
-
 
14224
  end;
-
 
14225
end;
-
 
14226
 
-
 
14227
{------------------------------------------------------------------------------}
-
 
14228
{created 31.1.2005 JB.}
-
 
14229
{replacement original Hori's functionality}
-
 
14230
{24.4.2006 create WaveY as supplement like WaveX functions}
-
 
14231
{14.5.2006 added functionality for tile drawing through PatternIndex}
-
 
14232
 
-
 
14233
function TD2D.D2DMeshMapToWave(dds: TDirectDrawSurface; Transparent: Boolean;
-
 
14234
  TransparentColor: Integer; X, Y, iWidth, iHeight, PatternIndex: Integer;
-
 
14235
  PatternRect: TRect;
-
 
14236
  Amp, Len, Ph, Alpha: Integer; effect: TRenderType; DoY: Boolean): Boolean;
-
 
14237
  function D2DTexturedOn(dds: TDirectDrawSurface; Transparent: Boolean; var TexNo: Integer): Boolean;
-
 
14238
  {special version of mapping for TDirectDrawSurface only}
-
 
14239
  {set up transparent color from this surface}
-
 
14240
  var I: Integer;
-
 
14241
    TexName: string;
-
 
14242
  begin
-
 
14243
    Result := False;
-
 
14244
    TexNo := -1;
-
 
14245
    RenderError := FDDraw.D3DDevice7.SetTexture(0, nil) <> DD_OK;
-
 
14246
    {pokud je seznam prazdny, nahrej texturu}
-
 
14247
    if dds.Caption <> '' then TexName := dds.Caption
-
 
14248
    else TexName := IntToStr(Integer(dds));
-
 
14249
    if not FD2DTexture.{$IFDEF VER4UP}CanFindTexture{$ELSE}CanFindTexture2{$ENDIF}(TexName) then
-
 
14250
      {nepovede-li se to, pak ven}
-
 
14251
      if not FD2DTexture.{$IFDEF VER4UP}LoadTextures{$ELSE}LoadTextures3{$ENDIF}(dds, Transparent, TransparentColor, TexName) then Exit;
-
 
14252
    I := FD2DTexture.Find(TexName);
-
 
14253
    if I = -1 then Exit;
-
 
14254
    TexNo := I;
-
 
14255
    {set pattern as texture}
-
 
14256
//    FDDraw.D3DDevice7.SetTextureStageState(0, D3DTSS_MAGFILTER, DWord(Ord(FD2DTextureFilter)+1));
-
 
14257
//    FDDraw.D3DDevice7.SetTextureStageState(0, D3DTSS_MINFILTER, DWord(Ord(FD2DTextureFilter)+1));
-
 
14258
    try
-
 
14259
      RenderError := FDDraw.D3DDevice7.SetTexture(0, FD2DTexture.Texture[I].D2DTexture.Surface.IDDSurface7) <> DD_OK;
-
 
14260
      //Result := True; {not RetderError}
-
 
14261
    except
-
 
14262
      RenderError := True;
-
 
14263
      Result := False;
-
 
14264
      FD2DTexture.D2DPruneAllTextures;
-
 
14265
      Exit;
-
 
14266
    end;
-
 
14267
    {set transparent area}
-
 
14268
    RenderError := FDDraw.D3DDevice7.SetRenderState(D3DRENDERSTATE_COLORKEYENABLE, Ord(FD2DTexture.Texture[I].D2DTexture.Transparent)) <> DD_OK;
-
 
14269
    Result := not RenderError;
-
 
14270
  end;
-
 
14271
type
-
 
14272
  TVertexArray = array{$IFNDEF VER4UP} [0..0]{$ENDIF} of TD3DTLVERTEX;
-
 
14273
  {$IFNDEF VER4UP}
-
 
14274
  PVertexArray = ^TVertexArray;
-
 
14275
  {$ENDIF}
-
 
14276
var
-
 
14277
  SVertex: {$IFDEF VER4UP}TVertexArray{$ELSE}PVertexArray{$ENDIF};
-
 
14278
  I, maxVertex, maxPix, VStepVx, TexNo, Width, Height: Integer;
-
 
14279
  VStep, VStepTo, D, Z, FX1, FX2, FY1, FY2, SX, SY, X1, Y1, X2, Y2: Extended;
-
 
14280
  R: TRect;
-
 
14281
  clr: DWORD;
-
 
14282
begin
-
 
14283
  Result := False;
-
 
14284
  {zde uschovano maximum [0..1] po adjustaci textury, ktera nemela nektery rozmer 2^n}
-
 
14285
  {FD2DTexture.Texture[I].FloatX2;}
-
 
14286
  {FD2DTexture.Texture[I].FloatY2;}
-
 
14287
  {napr. pokud byl rozmer 0.7 pak je nutno prepocitat tento interval [0..0.7] na height}
-
 
14288
  if not D2DTexturedOn(dds, Transparent, TexNo) then Exit;
-
 
14289
  {musi se prenastavit velikost pokud je PatternIndex <> -1}
-
 
14290
  Width := iWidth;
-
 
14291
  Height := iHeight;
-
 
14292
  {remove into local variabled for multi-picture adjustation}
-
 
14293
  FX1 := FD2DTexture.Texture[TexNo].FloatX1;
-
 
14294
  FX2 := FD2DTexture.Texture[TexNo].FloatX2;
-
 
14295
  FY1 := FD2DTexture.Texture[TexNo].FloatY1;
-
 
14296
  FY2 := FD2DTexture.Texture[TexNo].FloatY2;
-
 
14297
  {when pattertindex selected, get real value of subtexture}
-
 
14298
  if (PatternIndex <> -1) {and (PatternRect <> ZeroRect)} then
-
 
14299
  begin
-
 
14300
    R := PatternRect;
-
 
14301
    Width := R.Right - R.Left;
-
 
14302
    Height := R.Bottom - R.Top;
-
 
14303
    {scale unit of full new width and height}
-
 
14304
    SX := 1 / FD2DTexture.Texture[TexNo].Width;
-
 
14305
    SY := 1 / FD2DTexture.Texture[TexNo].Height;
-
 
14306
    {remap there}
-
 
14307
    FX1 := R.Left * SX;
-
 
14308
    FX2 := R.Right * SX;
-
 
14309
    FY1 := R.Top * SY;
-
 
14310
    FY2 := R.Bottom * SY;
-
 
14311
  end;
-
 
14312
  {nastavuje se tolik vertexu, kolik je potreba}
-
 
14313
  {speculative set up of rows for better look how needed}
-
 
14314
  if not DoY then
-
 
14315
  begin
-
 
14316
    maxVertex := 2 * Trunc(Height / Len * 8);
-
 
14317
    if (maxVertex mod 2) > 0 then {top to limits}
-
 
14318
      Inc(maxVertex, 2);
-
 
14319
    if (maxVertex div 2) > Height then {correct to Height}
-
 
14320
      maxVertex := 2 * Height;
-
 
14321
  end
-
 
14322
  else
-
 
14323
  begin
-
 
14324
    maxVertex := 2 * Trunc(Width / Len * 8);
-
 
14325
    if (maxVertex mod 2) > 0 then {top to limits}
-
 
14326
      Inc(maxVertex, 2);
-
 
14327
    if (maxVertex div 2) > Width then {correct to Width}
-
 
14328
      maxVertex := 2 * Width;
-
 
14329
  end;
-
 
14330
 
-
 
14331
  {pocet pixlu mezi ploskami}
-
 
14332
  if not DoY then
-
 
14333
  begin
-
 
14334
    repeat
-
 
14335
      if (Height mod (maxVertex div 2)) <> 0 then
-
 
14336
        Inc(maxVertex, 2);
-
 
14337
      maxPix := Height div (maxVertex div 2);
-
 
14338
    until (Height mod (maxVertex div 2)) = 0;
-
 
14339
    {krok k nastaveni vertexu}
-
 
14340
    VStep := (FY2 - FY1) / (maxVertex div 2);
-
 
14341
  end
-
 
14342
  else
-
 
14343
  begin
-
 
14344
    repeat
-
 
14345
      if (Width mod (maxVertex div 2)) <> 0 then
-
 
14346
        Inc(maxVertex, 2);
-
 
14347
      maxPix := Width div (maxVertex div 2);
-
 
14348
    until (Width mod (maxVertex div 2)) = 0;
-
 
14349
    {krok k nastaveni vertexu}
-
 
14350
    VStep := (FX2 - FX1) / (maxVertex div 2);
-
 
14351
  end;
-
 
14352
  //prostor
-
 
14353
  {$IFDEF VER4UP}
-
 
14354
  SetLength(SVertex, maxVertex);
-
 
14355
  {$ELSE}
-
 
14356
  SVertex := AllocMem(maxVertex * SizeOf(TD3DTLVERTEX));
-
 
14357
  try
-
 
14358
  {$ENDIF}
-
 
14359
    //inicializace
-
 
14360
    VStepVx := 0;
-
 
14361
    VStepTo := 0;
-
 
14362
    D := ph / (128 / PI); {shift wave}
-
 
14363
    Z := (Len / 2) / PI; {wave length to radians}
-
 
14364
    clr := D2DVertColor(Effect, Alpha); //effect cumulate to one param and one line of code
-
 
14365
    {vlastni nastaveni vertexu v pasu vertexu}
-
 
14366
    for I := 0 to maxVertex - 1 do
-
 
14367
    begin
-
 
14368
      SVertex[I].Specular := D3DRGB(1.0, 1.0, 1.0);
-
 
14369
      SVertex[I].rhw := 1.0;
-
 
14370
      SVertex[I].color := clr;
-
 
14371
      if not DoY then
-
 
14372
        case (I + 1) mod 2 of //triangle driver
-
 
14373
          1: begin
-
 
14374
              if I <> 0 then Inc(VStepVx, maxPix);
-
 
14375
              SVertex[I].sx := X + Trunc(amp * Sin((Y + VStepVx) / Z + D)) - 0.5; //levy
-
 
14376
              SVertex[I].sy := Y + VStepVx - 0.5;
-
 
14377
              if FMirrorFlipSet = [rmfMirror] then
-
 
14378
              begin
-
 
14379
                X1 := FX2; if I <> 0 then VStepTo := VStepTo + VStep;
-
 
14380
                Y1 := FY1 + VStepTo;
-
 
14381
              end
-
 
14382
              else
-
 
14383
                if FMirrorFlipSet = [rmfFlip] then
-
 
14384
                begin
-
 
14385
                  X1 := FX1;
-
 
14386
                  Y1 := FY2 - VStepTo;
-
 
14387
                end
-
 
14388
                else
-
 
14389
                  if FMirrorFlipSet = [rmfMirror, rmfFlip] then
-
 
14390
                  begin
-
 
14391
                    X1 := FX2;
-
 
14392
                    Y1 := FY2 - VStepTo;
-
 
14393
                  end
-
 
14394
                  else
-
 
14395
                  begin
-
 
14396
                    X1 := FX1; if I <> 0 then VStepTo := VStepTo + VStep;
-
 
14397
                    Y1 := FY1 + VStepTo;
-
 
14398
                  end;
-
 
14399
              SVertex[I].tu := X1;
-
 
14400
              SVertex[I].tv := Y1;
-
 
14401
            end;
-
 
14402
          0: begin
-
 
14403
              SVertex[I].sx := X + Width + Trunc(amp * Sin((Y + VStepVx) / Z + D)) - 1; //pravy
-
 
14404
              SVertex[I].sy := Y + VStepVx;
-
 
14405
              if FMirrorFlipSet = [rmfMirror] then
-
 
14406
              begin
-
 
14407
                X2 := FX1;
-
 
14408
                Y2 := FY1 + VStepTo;
-
 
14409
              end
-
 
14410
              else
-
 
14411
                if FMirrorFlipSet = [rmfFlip] then
-
 
14412
                begin
-
 
14413
                  X2 := FX2;
-
 
14414
                  Y2 := FY2 - VStepTo; if I <> 0 then VStepTo := VStepTo + VStep;
-
 
14415
                end
-
 
14416
                else
-
 
14417
                  if FMirrorFlipSet = [rmfMirror, rmfFlip] then
-
 
14418
                  begin
-
 
14419
                    X2 := FX1;
-
 
14420
                    Y2 := FY2 - VStepTo; if I <> 0 then VStepTo := VStepTo + VStep;
-
 
14421
                  end
-
 
14422
                  else
-
 
14423
                  begin
-
 
14424
                    X2 := FX2;
-
 
14425
                    Y2 := FY1 + VStepTo;
-
 
14426
                  end;
-
 
14427
              SVertex[I].tu := X2;
-
 
14428
              SVertex[I].tv := Y2;
-
 
14429
            end;
-
 
14430
        end {case}
-
 
14431
      else
-
 
14432
        case (I + 1) mod 2 of //triangle driver
-
 
14433
          0: begin
-
 
14434
              if I <> 0 then Inc(VStepVx, maxPix);
-
 
14435
              SVertex[I].sy := Y + Trunc(amp * Sin((X + VStepVx) / Z + D)) - 0.5; //hore
-
 
14436
              SVertex[I].sx := X + VStepVx - 0.5;
-
 
14437
              if FMirrorFlipSet = [rmfMirror] then
-
 
14438
              begin
-
 
14439
                Y1 := FY1; if I <> 0 then VStepTo := VStepTo + VStep;
-
 
14440
                X1 := FX2 - VStepTo;
-
 
14441
              end
-
 
14442
              else
-
 
14443
                if FMirrorFlipSet = [rmfFlip] then
-
 
14444
                begin
-
 
14445
                  Y1 := FY2; if I <> 0 then VStepTo := VStepTo + VStep;
-
 
14446
                  X1 := FX1 + VStepTo;
-
 
14447
                end
-
 
14448
                else
-
 
14449
                  if FMirrorFlipSet = [rmfMirror, rmfFlip] then
-
 
14450
                  begin
-
 
14451
                    Y1 := FY2; if I <> 0 then VStepTo := VStepTo + VStep;
-
 
14452
                    X1 := FX2 - VStepTo;
-
 
14453
                  end
-
 
14454
                  else
-
 
14455
                  begin
-
 
14456
                    Y1 := FY1; if I <> 0 then VStepTo := VStepTo + VStep;
-
 
14457
                    X1 := FX1 + VStepTo;
-
 
14458
                  end;
-
 
14459
              SVertex[I].tu := X1;
-
 
14460
              SVertex[I].tv := Y1;
-
 
14461
            end;
-
 
14462
          1: begin
-
 
14463
              SVertex[I].sy := Y + Height + Trunc(amp * Sin((X + VStepVx) / Z + D)) - 1; //dole
-
 
14464
              SVertex[I].sx := X + VStepVx;
-
 
14465
              if FMirrorFlipSet = [rmfMirror] then
-
 
14466
              begin
-
 
14467
                Y2 := FY2;
-
 
14468
                X2 := FX2 - VStepTo;
-
 
14469
              end
-
 
14470
              else
-
 
14471
                if FMirrorFlipSet = [rmfFlip] then
-
 
14472
                begin
-
 
14473
                  Y2 := FY1;
-
 
14474
                  X2 := FX1 + VStepTo;
-
 
14475
                end
-
 
14476
                else
-
 
14477
                  if FMirrorFlipSet = [rmfMirror, rmfFlip] then
-
 
14478
                  begin
-
 
14479
                    Y2 := FY1;
-
 
14480
                    X2 := FX2 - VStepTo;
-
 
14481
                  end
-
 
14482
                  else
-
 
14483
                  begin
-
 
14484
                    Y2 := FY2;
-
 
14485
                    X2 := FX1 + VStepTo;
-
 
14486
                  end;
-
 
14487
              SVertex[I].tu := X2;
-
 
14488
              SVertex[I].tv := Y2;
-
 
14489
            end;
-
 
14490
        end;
-
 
14491
    end;
-
 
14492
    {set of effect}
-
 
14493
    case Effect of
-
 
14494
      rtDraw: D2DEffectSolid;
-
 
14495
      rtBlend: D2DEffectBlend;
-
 
14496
      rtAdd: D2DEffectAdd;
-
 
14497
      rtSub: D2DEffectSub;
-
 
14498
    end;
-
 
14499
    with FDDraw.D3DDevice7 do
-
 
14500
    begin
-
 
14501
      {kreslime hned zde}//render now and here
-
 
14502
      Result := DrawPrimitive(D3DPT_TRIANGLESTRIP, D3DFVF_TLVERTEX, SVertex[0], maxVertex, D3DDP_WAIT) = DD_OK;
-
 
14503
      //zpet hodnoty
-
 
14504
      //FIX InitVertex;
-
 
14505
      FMirrorFlipSet := []; {only for one operation, back to normal position}
-
 
14506
      {restore device status}
-
 
14507
      RenderError := SetTextureStageState(1, D3DTSS_COLOROP, Ord(D3DTOP_DISABLE)) <> DD_OK;
-
 
14508
      RenderError := SetTextureStageState(1, D3DTSS_ALPHAOP, Ord(D3DTOP_DISABLE)) <> DD_OK;
-
 
14509
      RenderError := SetRenderState(D3DRENDERSTATE_ALPHABLENDENABLE, 0) <> DD_OK;
-
 
14510
    end;
-
 
14511
  {$IFNDEF VER4UP}
-
 
14512
  finally
-
 
14513
    FreeMem(SVertex, maxVertex * SizeOf(TD3DTLVERTEX));
-
 
14514
  end;
-
 
14515
  {$ENDIF}
-
 
14516
end;
-
 
14517
 
-
 
14518
function TD2D.D2DRenderWaveX(Image: TPictureCollectionItem; X, Y, Width,
-
 
14519
  Height, PatternIndex: Integer; RenderType: TRenderType; transparent: Boolean;
-
 
14520
  amp, Len, ph, Alpha: Integer): Boolean;
-
 
14521
begin
-
 
14522
  Result := False; if not CanUseD2D then Exit;
-
 
14523
  {load textures and map, do make wave mesh and render it}
-
 
14524
  Result := D2DMeshMapToWave(Image.PatternSurfaces[PatternIndex], transparent,
-
 
14525
    Image.FTransparentColor, X, Y, Width, Height, PatternIndex,
-
 
14526
    Image.PatternRects[PatternIndex],
-
 
14527
    amp, Len, ph, Alpha, RenderType{$IFNDEF VER4UP}, False{$ENDIF});
-
 
14528
end;
-
 
14529
 
-
 
14530
function TD2D.D2DRenderWaveXDDS(Source: TDirectDrawSurface; X, Y, Width,
-
 
14531
  Height: Integer; RenderType: TRenderType; Transparent: Boolean; Amp, Len, Ph, Alpha: Integer): Boolean;
-
 
14532
begin
-
 
14533
  Result := False; if not CanUseD2D then Exit;
-
 
14534
  {load textures and map, do make wave mesh and render it}
-
 
14535
  Result := D2DMeshMapToWave(Source, transparent, -1, X, Y, Width, Height, -1,
-
 
14536
    ZeroRect,
-
 
14537
    amp, Len, ph, Alpha, RenderType{$IFNDEF VER4UP}, False{$ENDIF});
-
 
14538
end;
-
 
14539
 
-
 
14540
function TD2D.D2DRenderWaveY(Image: TPictureCollectionItem; X, Y, Width,
-
 
14541
  Height, PatternIndex: Integer; RenderType: TRenderType; Transparent: Boolean;
-
 
14542
  Amp, Len, Ph, Alpha: Integer): Boolean;
-
 
14543
begin
-
 
14544
  Result := False; if not CanUseD2D then Exit;
-
 
14545
  {load textures and map, do make wave mesh and render it}
-
 
14546
  Result := D2DMeshMapToWave(Image.PatternSurfaces[PatternIndex], transparent,
-
 
14547
    Image.FTransparentColor, X, Y, Width, Height, PatternIndex,
-
 
14548
    Image.PatternRects[PatternIndex],
-
 
14549
    amp, Len, ph, Alpha, RenderType, True);
-
 
14550
end;
-
 
14551
 
-
 
14552
function TD2D.D2DRenderWaveYDDS(Source: TDirectDrawSurface; X, Y, Width,
-
 
14553
  Height: Integer; RenderType: TRenderType; Transparent: Boolean;
-
 
14554
  Amp, Len, Ph, Alpha: Integer): Boolean;
-
 
14555
begin
-
 
14556
  Result := False; if not CanUseD2D then Exit;
-
 
14557
  {load textures and map, do make wave mesh and render it}
-
 
14558
  Result := D2DMeshMapToWave(Source, transparent, -1, X, Y, Width, Height, -1,
-
 
14559
    ZeroRect,
-
 
14560
    amp, Len, ph, Alpha, RenderType, True);
-
 
14561
end;
-
 
14562
 
-
 
14563
function TD2D.D2DTexturedOnRect(Rect: TRect; Color: LongInt): Boolean;
-
 
14564
var I: Integer;
-
 
14565
begin
-
 
14566
  Result := False;
-
 
14567
  FDDraw.D3DDevice7.SetTexture(0, nil);
-
 
14568
  if not FD2DTexture.{$IFDEF VER4UP}CanFindTexture{$ELSE}CanFindTexture3{$ENDIF}(Color) then {when no texture in list try load it}
-
 
14569
    if not FD2DTexture.{$IFDEF VER4UP}LoadTextures{$ELSE}LoadTextures4{$ENDIF}(Color) then Exit; {on error occurr go out}
-
 
14570
  I := FD2DTexture.Find('$' + IntToStr(Color)); //simply .. but stupid
-
 
14571
  if I = -1 then Exit;
-
 
14572
  {set pattern as texture}
-
 
14573
//  FDDraw.D3DDevice7.SetTextureStageState(0, D3DTSS_MAGFILTER, DWord(Ord(FD2DTextureFilter)+1));
-
 
14574
//  FDDraw.D3DDevice7.SetTextureStageState(0, D3DTSS_MINFILTER, DWord(Ord(FD2DTextureFilter)+1));
-
 
14575
  try
-
 
14576
    RenderError := FDDraw.D3DDevice7.SetTexture(0, FD2DTexture.Texture[I].D2DTexture.Surface.IDDSurface7) <> DD_OK;
-
 
14577
  except
-
 
14578
    RenderError := True;
-
 
14579
    FD2DTexture.D2DPruneAllTextures;
-
 
14580
    exit;
-
 
14581
  end;
-
 
14582
  {set transparent part}
-
 
14583
  FDDraw.D3DDevice7.SetRenderState(D3DRENDERSTATE_COLORKEYENABLE, 0); //no transparency
-
 
14584
 
-
 
14585
  D2DTU(FD2DTexture.Texture[I]);
-
 
14586
  Result := not RenderError;
-
 
14587
end;
-
 
14588
 
-
 
14589
function TD2D.D2DTexturedOnSubRect(Image: TPictureCollectionItem;
-
 
14590
  Pattern: Integer; SubPatternRect, SubRect: TRect; RenderType: TRenderType;
-
 
14591
  Alpha: Byte): Boolean;
-
 
14592
label
-
 
14593
  lblHop;  
-
 
14594
var
-
 
14595
  I, W, H: Integer;
-
 
14596
  SrcX, SrcY, diffX: Double;
-
 
14597
  R, tmpSubRect: TRect;
-
 
14598
  Q: TTextureRec;
-
 
14599
  qFloatX1, qFloatX2, qFloatY1, qFloatY2: Double;
-
 
14600
begin
-
 
14601
  Result := False;
-
 
14602
  FDDraw.D3DDevice7.SetTexture(0, nil);
-
 
14603
  if not FD2DTexture.CanFindTexture(Image) then {when no texture in list try load it}
-
 
14604
    if not FD2DTexture.LoadTextures(Image) then {loading is here}
-
 
14605
      Exit; {on error occurr out}
-
 
14606
  I := FD2DTexture.Find(Image.Name);
-
 
14607
  if I = -1 then Exit;
-
 
14608
  {set pattern as texture}
-
 
14609
//  FDDraw.D3DDevice7.SetTextureStageState(0, D3DTSS_MAGFILTER, DWord(Ord(FD2DTextureFilter)+1));
-
 
14610
//  FDDraw.D3DDevice7.SetTextureStageState(0, D3DTSS_MINFILTER, DWord(Ord(FD2DTextureFilter)+1));
-
 
14611
  try
-
 
14612
    FDDraw.D3DDevice7.SetTexture(0, FD2DTexture.Texture[I].D2DTexture.Surface.IDDSurface7);
-
 
14613
    case RenderType of
-
 
14614
      rtDraw: begin D2DEffectSolid; D2DWhite; end;
-
 
14615
      rtBlend: begin D2DEffectBlend; D2DAlphaVertex(Alpha); end;
-
 
14616
      rtAdd: begin D2DEffectAdd; D2DFade(Alpha); end;
-
 
14617
      rtSub: begin D2DEffectSub; D2DFade(Alpha); end;
-
 
14618
    end;
-
 
14619
  except
-
 
14620
    RenderError := true;
-
 
14621
    FD2DTexture.D2DPruneAllTextures;
-
 
14622
    Image.Restore;
-
 
14623
    SetD2DTextureFilter(D2D_LINEAR);
-
 
14624
    Exit;
-
 
14625
  end;
-
 
14626
  {set transparent part}
-
 
14627
  FDDraw.D3DDevice7.SetRenderState(D3DRENDERSTATE_COLORKEYENABLE, Ord(FD2DTexture.Texture[I].D2DTexture.Transparent));
-
 
14628
  {except for Draw when alphachannel exists}
-
 
14629
  {change for blend drawing but save transparent area still}
-
 
14630
  if FD2DTexture.Texture[I].AlphaChannel then
-
 
14631
    {when is Draw selected then}
-
 
14632
    if RenderType = rtDraw then
-
 
14633
    begin
-
 
14634
      D2DEffectBlend; D2DAlphaVertex($FF);
-
 
14635
    end;
-
 
14636
  {pokud je obrazek rozdeleny, nastav oka site}
-
 
14637
  if (Image.PatternHeight <> 0) or (Image.PatternWidth <> 0) then
-
 
14638
  begin
-
 
14639
    {vezmi rect jenom dilku}
-
 
14640
    R := Image.PatternRects[Pattern];
-
 
14641
 
-
 
14642
    if not CompareMem(@SubRect, @ZeroRect, SizeOf(SubRect)) then
-
 
14643
    begin
-
 
14644
      {ktere oko site to je?}
-
 
14645
      W := SubRect.Right - SubRect.Left; {takhle je siroky}
-
 
14646
      H := SubRect.Bottom - SubRect.Top; {takhle je vysoky}
-
 
14647
      tmpSubRect := Bounds(R.Left + SubRect.Left, R.Top + SubRect.Top, W, H);
-
 
14648
      if RectInRect(tmpSubRect, R) then
-
 
14649
      begin
-
 
14650
        {pokud je subrect jeste v ramci patternu, musi se posouvat podle patternindex}
-
 
14651
        Inc(R.Left, SubRect.Left);
-
 
14652
        Inc(R.Top, SubRect.Top);
-
 
14653
        if (R.Left + W) < R.Right then R.Right := R.Left + W;
-
 
14654
        if (R.Top + H) < R.Bottom then R.Bottom := R.Top + H;
-
 
14655
        goto lblHop;
-
 
14656
      end;
-
 
14657
    end;
-
 
14658
    SrcX := 1 / FD2DTexture.Texture[I].Width;
-
 
14659
    SrcY := 1 / FD2DTexture.Texture[I].Height;
-
 
14660
    //namapovani vertexu na texturu
-
 
14661
    FD2DTexture.Texture[I].FloatX1 := SrcX * R.Left;
-
 
14662
    FD2DTexture.Texture[I].FloatY1 := SrcY * R.Top;
-
 
14663
    {for meshed subimage contain one image only can be problem there}
-
 
14664
    diffX := 0.5; if Image.PatternCount = 1 then diffX := 0;
-
 
14665
    FD2DTexture.Texture[I].FloatX2 := SrcX * (R.Right - diffX);
-
 
14666
    FD2DTexture.Texture[I].FloatY2 := SrcY * (R.Bottom - diffX);
-
 
14667
    if not (
-
 
14668
      (SubPatternRect.Left = Image.PatternRects[Pattern].Left) and
-
 
14669
      (SubPatternRect.Top = Image.PatternRects[Pattern].Top) and
-
 
14670
      (SubPatternRect.Right = Image.PatternRects[Pattern].Right) and
-
 
14671
      (SubPatternRect.Bottom = Image.PatternRects[Pattern].Bottom))
-
 
14672
    then
-
 
14673
    begin
-
 
14674
      {remaping subtexture via subpattern}
-
 
14675
      Q.FloatX1 := SrcX * SubPatternRect.Left;
-
 
14676
      Q.FloatY1 := SrcY * SubPatternRect.Top;
-
 
14677
      Q.FloatX2 := SrcX * (SubPatternRect.Right - diffX);
-
 
14678
      Q.FloatY2 := SrcY * (SubPatternRect.Bottom - diffX);
-
 
14679
      D2DTU(Q); {with mirroring/flipping}
-
 
14680
      Result := True;
-
 
14681
      Exit;
-
 
14682
    end;
-
 
14683
  end; {jinak celeho obrazku}
-
 
14684
 
-
 
14685
  if not CompareMem(@SubRect, @ZeroRect, SizeOf(SubRect)) then
-
 
14686
    if RectInRect(SubRect, Bounds(0,0, FD2DTexture.Texture[I].Width, FD2DTexture.Texture[I].Height)) then
-
 
14687
    begin
-
 
14688
      R := SubRect;
-
 
14689
     lblHop:
-
 
14690
      SrcX := 1 / FD2DTexture.Texture[I].Width;
-
 
14691
      SrcY := 1 / FD2DTexture.Texture[I].Height;
-
 
14692
      //namapovani vertexu na texturu
-
 
14693
      qFloatX1 := FD2DTexture.Texture[I].FloatX1;
-
 
14694
      qFloatY1 := FD2DTexture.Texture[I].FloatY1;
-
 
14695
      qFloatX2 := FD2DTexture.Texture[I].FloatX2;
-
 
14696
      qFloatY2 := FD2DTexture.Texture[I].FloatY2;
-
 
14697
      try
-
 
14698
        FD2DTexture.Texture[I].FloatX1 := SrcX * R.Left;
-
 
14699
        FD2DTexture.Texture[I].FloatY1 := SrcY * R.Top;
-
 
14700
        {for meshed subimage contain one image only can be problem there}
-
 
14701
        diffX := 0.5; if Image.PatternCount = 1 then diffX := 0;
-
 
14702
        FD2DTexture.Texture[I].FloatX2 := SrcX * (R.Right - diffX);
-
 
14703
        FD2DTexture.Texture[I].FloatY2 := SrcY * (R.Bottom - diffX);
-
 
14704
        {remaping subtexture via subpattern}
-
 
14705
        D2DTU(FD2DTexture.Texture[I]); {with mirroring/flipping}
-
 
14706
        Result := True;
-
 
14707
        Exit;
-
 
14708
      finally
-
 
14709
        FD2DTexture.Texture[I].FloatX1 := qFloatX1;
-
 
14710
        FD2DTexture.Texture[I].FloatY1 := qFloatY1;
-
 
14711
        FD2DTexture.Texture[I].FloatX2 := qFloatX2;
-
 
14712
        FD2DTexture.Texture[I].FloatY2 := qFloatY2;
-
 
14713
      end;
-
 
14714
    end;
-
 
14715
 
-
 
14716
  {  X1,Y1             X2,Y1
-
 
14717
  0  +-----------------+  1
-
 
14718
     |                 |
-
 
14719
     |                 |
-
 
14720
     |                 |
-
 
14721
     |                 |
-
 
14722
  2  +-----------------+  3
-
 
14723
     X1,Y2             X2,Y2  }
-
 
14724
  D2DTU(FD2DTexture.Texture[I]);
-
 
14725
  Result := True;
-
 
14726
end;
-
 
14727
 
-
 
14728
function TD2D.D2DRenderColoredPartition(Image: TPictureCollectionItem;
-
 
14729
  DestRect: TRect;
-
 
14730
  PatternIndex, Color, Specular: Integer;
-
 
14731
  Faded: Boolean;
-
 
14732
  SourceRect: TRect;
-
 
14733
  RenderType: TRenderType;
-
 
14734
  Alpha: Byte): Boolean;
-
 
14735
begin
-
 
14736
  Result := False; if not CanUseD2D then Exit;
-
 
14737
  {set of effect before fade}
-
 
14738
  case RenderType of
-
 
14739
    rtDraw: D2DEffectSolid;
-
 
14740
    rtBlend: D2DEffectBlend;
-
 
14741
    rtAdd: D2DEffectAdd;
-
 
14742
    rtSub: D2DEffectSub;
-
 
14743
  end;
-
 
14744
  if Faded then D2DFade(Alpha);
-
 
14745
 
-
 
14746
  D2DColoredVertex(Color);
-
 
14747
  if Specular <> Round(D3DRGB(1.0, 1.0, 1.0)) then
-
 
14748
    D2DSpecularVertex(Specular);
-
 
14749
  {load textures and map it}
-
 
14750
  if D2DTexturedOn(Image, PatternIndex, SourceRect, RenderType, Alpha) then
-
 
14751
  begin
-
 
14752
    D2DRect(DestRect);
-
 
14753
    {render it}
-
 
14754
    Result := RenderQuad;
-
 
14755
  end;
-
 
14756
end;
-
 
14757
 
-
 
14758
function TD2D.D2DRenderFillRect(Rect: TRect; RGBColor: LongInt;
-
 
14759
  RenderType: TRenderType; Alpha: Byte): Boolean;
-
 
14760
begin
-
 
14761
  Result := False; if not CanUseD2D then Exit;
-
 
14762
  case RenderType of
-
 
14763
    rtDraw: begin D2DEffectSolid; D2DColoredVertex(RGBColor); end;
-
 
14764
    rtBlend: begin D2DEffectBlend; D2DAlphaVertex(Alpha); end;
-
 
14765
    rtAdd: begin D2DEffectAdd; D2DFade(Alpha); end;
-
 
14766
    rtSub: begin D2DEffectSub; D2DFade(Alpha); end;
-
 
14767
  end;
-
 
14768
  if D2DTexturedOnRect(Rect, RGBColor) then
-
 
14769
  begin
-
 
14770
    D2DRect(Rect);
-
 
14771
    Result := RenderQuad;
-
 
14772
  end;
-
 
14773
end;
-
 
14774
 
-
 
14775
function TD2D.D2DRenderRotateModeCol(Image: TPictureCollectionItem;
-
 
14776
  RenderType: TRenderType;
-
 
14777
  RotX, RotY, PictWidth, PictHeight, PatternIndex: Integer; CenterX,
-
 
14778
  CenterY: Double; Angle: single; Color: Integer; Alpha: Byte): Boolean;
-
 
14779
begin
-
 
14780
  Result := False; if not CanUseD2D then Exit;
-
 
14781
  {set of effect before colored}
-
 
14782
  case RenderType of
-
 
14783
    rtDraw: D2DEffectSolid;
-
 
14784
    rtAdd: D2DEffectAdd;
-
 
14785
    rtSub: D2DEffectSub;
-
 
14786
    rtBlend: D2DEffectBlend;
-
 
14787
  end;
-
 
14788
  D2DFadeColored(Color, Alpha);
-
 
14789
  {load textures and map it}
-
 
14790
  if D2DTexturedOn(Image, PatternIndex, Image.PatternRects[PatternIndex], RenderType, Alpha) then
-
 
14791
  begin
-
 
14792
    {do rotate mesh}
-
 
14793
    D2DRotate(RotX, RotY, PictWidth, PictHeight, CenterX, CenterY, Angle);
-
 
14794
    {render it}
-
 
14795
    Result := RenderQuad;
-
 
14796
  end;
-
 
14797
end;
-
 
14798
 
-
 
14799
function TD2D.D2DRenderRotateModeColDDS(Image: TDirectDrawSurface;
-
 
14800
  RotX, RotY, PictWidth, PictHeight: Integer; RenderType: TRenderType;
-
 
14801
  CenterX, CenterY: Double; Angle: Single; Color: Integer; Alpha: Byte;
-
 
14802
  Transparent: Boolean): Boolean;
-
 
14803
begin
-
 
14804
  Result := False; if not CanUseD2D then Exit;
-
 
14805
  {set of effect}
-
 
14806
  D2DFadeColored(Color, Alpha);
-
 
14807
  {load textures and map it}
-
 
14808
  if D2DTexturedOnDDS(Image, ZeroRect, Transparent, RenderType, Alpha) then
-
 
14809
  begin
-
 
14810
    {do rotate mesh}
-
 
14811
    D2DRotate(RotX, RotY, PictWidth, PictHeight, CenterX, CenterY, Angle);
-
 
14812
    {render it}
-
 
14813
    Result := RenderQuad;
-
 
14814
  end;
-
 
14815
end;
-
 
14816
 
-
 
14817
procedure TD2D.D2DEffectSolid;
-
 
14818
begin
-
 
14819
  with FDDraw.D3DDevice7 do
-
 
14820
  begin
-
 
14821
    SetRenderState(D3DRENDERSTATE_ALPHABLENDENABLE, 0);
-
 
14822
    //SetRenderState(D3DRENDERSTATE_FILLMODE, Integer(D3DFILL_SOLID));
-
 
14823
    SetRenderState(D3DRENDERSTATE_COLORKEYENABLE, Integer(True));
-
 
14824
    SetRenderState(D3DRENDERSTATE_SRCBLEND, Integer(D3DBLEND_ONE));
-
 
14825
  end;
-
 
14826
end;
-
 
14827
 
-
 
14828
procedure TD2D.D2DEffectBlend;
-
 
14829
begin
-
 
14830
  with FDDraw.D3DDevice7 do
-
 
14831
  begin
-
 
14832
    SetRenderState(D3DRENDERSTATE_ALPHABLENDENABLE, 1);
-
 
14833
    SetRenderState(D3DRENDERSTATE_SRCBLEND, Integer(D3DBLEND_SRCALPHA));
-
 
14834
    SetRenderState(D3DRENDERSTATE_DESTBLEND, Integer(D3DBLEND_INVSRCALPHA));
-
 
14835
 
-
 
14836
    SetTextureStageState(0, D3DTSS_COLOROP, Integer(D3DTOP_MODULATE));
-
 
14837
    SetTextureStageState(0, D3DTSS_COLORARG1, Integer(D3DTA_TEXTURE));
-
 
14838
    SetTextureStageState(0, D3DTSS_COLORARG2, Integer(D3DTA_CURRENT));
-
 
14839
 
-
 
14840
    SetTextureStageState(0, D3DTSS_ALPHAOP, Integer(D3DTOP_BLENDDIFFUSEALPHA));
-
 
14841
    SetTextureStageState(0, D3DTSS_ALPHAARG1, Integer(D3DTA_TEXTURE));
-
 
14842
    SetTextureStageState(0, D3DTSS_ALPHAARG2, Integer(D3DTA_CURRENT));
-
 
14843
 
-
 
14844
    SetTextureStageState(0, D3DTSS_ALPHAOP, Integer(D3DTOP_MODULATE));
-
 
14845
  end;
-
 
14846
end;
-
 
14847
 
-
 
14848
procedure TD2D.D2DEffectAdd;
-
 
14849
begin
-
 
14850
  with FDDraw.D3DDevice7 do
-
 
14851
  begin
-
 
14852
    SetRenderState(D3DRENDERSTATE_ALPHABLENDENABLE, 1);
-
 
14853
    SetRenderState(D3DRENDERSTATE_SRCBLEND, Integer(D3DBLEND_ONE));
-
 
14854
    SetRenderState(D3DRENDERSTATE_DESTBLEND, Integer(D3DBLEND_ONE));
-
 
14855
    SetTextureStageState(0, D3DTSS_ALPHAOP, Ord(D3DTOP_SELECTARG1));
-
 
14856
    SetTextureStageState(0, D3DTSS_ALPHAARG1,  D3DTA_CURRENT);
-
 
14857
    SetTextureStageState(0, D3DTSS_ALPHAOP, Integer(D3DTOP_MODULATE));
-
 
14858
  end;
-
 
14859
end;
-
 
14860
 
-
 
14861
procedure TD2D.D2DEffectSub;
-
 
14862
begin
-
 
14863
  with FDDraw.D3DDevice7 do
-
 
14864
  begin
-
 
14865
    SetRenderState(D3DRENDERSTATE_ALPHABLENDENABLE, 1);
-
 
14866
    SetRenderState(D3DRENDERSTATE_SRCBLEND, Integer(D3DBLEND_ZERO));
-
 
14867
    SetRenderState(D3DRENDERSTATE_DESTBLEND, Integer(D3DBLEND_INVSRCCOLOR));
-
 
14868
    SetTextureStageState(0, D3DTSS_ALPHAOP, Ord(D3DTOP_SELECTARG1));
-
 
14869
    SetTextureStageState(0, D3DTSS_ALPHAARG1,  D3DTA_CURRENT);
-
 
14870
    SetTextureStageState(0, D3DTSS_ALPHAOP, Integer(D3DTOP_MODULATE));
-
 
14871
  end;
-
 
14872
end;
-
 
14873
 
-
 
14874
function TD2D.D2DAlphaVertex(Alpha: Integer): Integer;
-
 
14875
begin
-
 
14876
  Result := RGBA_MAKE($FF, $FF, $FF, Alpha);
-
 
14877
  FVertex[0].Color := Result;
-
 
14878
  FVertex[1].Color := Result;
-
 
14879
  FVertex[2].Color := Result;
-
 
14880
  FVertex[3].Color := Result;
-
 
14881
end;
-
 
14882
 
-
 
14883
procedure TD2D.D2DColoredVertex(C: Integer);
-
 
14884
begin
-
 
14885
  C := D3DRGB(C and $FF / 255, (C shr 8) and $FF / 255, (C shr 16) and $FF / 255);
-
 
14886
  FVertex[0].Color := C;
-
 
14887
  FVertex[1].Color := C;
-
 
14888
  FVertex[2].Color := C;
-
 
14889
  FVertex[3].Color := C;
-
 
14890
end;
-
 
14891
 
-
 
14892
procedure TD2D.D2DColAlpha(C, Alpha: Integer);
-
 
14893
begin
-
 
14894
  C := D3DRGBA(C and $FF / 255, (C shr 8) and $FF / 255, (C shr 16) and $FF / 255, Alpha / 255);
-
 
14895
  FVertex[0].Color := C;
-
 
14896
  FVertex[1].Color := C;
-
 
14897
  FVertex[2].Color := C;
-
 
14898
  FVertex[3].Color := C;
-
 
14899
end;
-
 
14900
 
-
 
14901
procedure TD2D.D2DSpecularVertex(C: Integer);
-
 
14902
begin
-
 
14903
  C := D3DRGB(C and $FF / 255, (C shr 8) and $FF / 255, (C shr 16) and $FF / 255);
-
 
14904
  FVertex[0].Specular := C;
-
 
14905
  FVertex[1].Specular := C;
-
 
14906
  FVertex[2].Specular := C;
-
 
14907
  FVertex[3].Specular := C;
-
 
14908
end;
-
 
14909
 
-
 
14910
procedure TD2D.D2DCol4Alpha(C1, C2, C3, C4, Alpha: Integer);
-
 
14911
begin
-
 
14912
  FVertex[0].Color := D3DRGBA(C1 and $FF / 255, (C1 shr 8) and $FF / 255,
-
 
14913
    (C1 shr 16) and $FF / 255, Alpha / 255);
-
 
14914
  FVertex[1].Color := D3DRGBA(C2 and $FF / 255, (C2 shr 8) and $FF / 255,
-
 
14915
    (C2 shr 16) and $FF / 255, Alpha / 255);
-
 
14916
  FVertex[2].Color := D3DRGBA(C3 and $FF / 255, (C3 shr 8) and $FF / 255,
-
 
14917
    (C3 shr 16) and $FF / 255, Alpha / 255);
-
 
14918
  FVertex[3].Color := D3DRGBA(C4 and $FF / 255, (C4 shr 8) and $FF / 255,
-
 
14919
    (C4 shr 16) and $FF / 255, Alpha / 255);
-
 
14920
end;
-
 
14921
 
-
 
14922
function TD2D.D2DVertColor(RenderType: TRenderType; Alpha: Byte): DWORD;
-
 
14923
begin
-
 
14924
  case RenderType of //effect cumulate to one param and four line of code
-
 
14925
    rtDraw: Result := RGB_MAKE($FF, $FF, $FF);
-
 
14926
    rtBlend: Result := RGBA_MAKE($FF, $FF, $FF, Alpha);
-
 
14927
    rtAdd: Result := RGB_MAKE(Alpha, Alpha, Alpha);
-
 
14928
    rtSub: Result := RGB_MAKE(Alpha, Alpha, Alpha);
-
 
14929
  else
-
 
14930
    Result := RGB_MAKE($FF, $FF, $FF);
-
 
14931
  end;
-
 
14932
end;
-
 
14933
 
-
 
14934
function TD2D.D2DWhite: Integer;
-
 
14935
begin
-
 
14936
  Result := RGB_MAKE($FF, $FF, $FF);
-
 
14937
  FVertex[0].Color := Result;
-
 
14938
  FVertex[1].Color := Result;
-
 
14939
  FVertex[2].Color := Result;
-
 
14940
  FVertex[3].Color := Result;
-
 
14941
end;
-
 
14942
 
-
 
14943
function TD2D.D2DFade(Alpha: Integer): Integer;
-
 
14944
begin
-
 
14945
  Result := RGB_MAKE(Alpha, Alpha, Alpha);
-
 
14946
  FVertex[0].Color := Result;
-
 
14947
  FVertex[1].Color := Result;
-
 
14948
  FVertex[2].Color := Result;
-
 
14949
  FVertex[3].Color := Result;
-
 
14950
end;
-
 
14951
 
-
 
14952
procedure TD2D.D2DFadeColored(C, Alpha: Integer);
-
 
14953
var mult: single;
-
 
14954
begin
-
 
14955
  mult := Alpha / 65025; //Alpha/255/255;
-
 
14956
  C := D3DRGB((C and $FF) * mult, ((C shr 8) and $FF) * mult, ((C shr 16) and $FF) * mult);
-
 
14957
  FVertex[0].Color := C;
-
 
14958
  FVertex[1].Color := C;
-
 
14959
  FVertex[2].Color := C;
-
 
14960
  FVertex[3].Color := C;
-
 
14961
end;
-
 
14962
 
-
 
14963
procedure TD2D.D2DFade4Colored(C1, C2, C3, C4, Alpha: Integer);
-
 
14964
var mult: single;
-
 
14965
begin
-
 
14966
  mult := Alpha / 65025; //Alpha/255/255;
-
 
14967
  FVertex[0].Color := D3DRGB((C1 and $FF) * mult, ((C1 shr 8) and $FF) * mult,
-
 
14968
    ((C1 shr 16) and $FF) * mult);
-
 
14969
  FVertex[1].Color := D3DRGB((C2 and $FF) * mult, ((C2 shr 8) and $FF) * mult,
-
 
14970
    ((C2 shr 16) and $FF) * mult);
-
 
14971
  FVertex[2].Color := D3DRGB((C3 and $FF) * mult, ((C3 shr 8) and $FF) * mult,
-
 
14972
    ((C3 shr 16) and $FF) * mult);
-
 
14973
  FVertex[3].Color := D3DRGB((C4 and $FF) * mult, ((C4 shr 8) and $FF) * mult,
-
 
14974
    ((C4 shr 16) and $FF) * mult);
-
 
14975
end;
-
 
14976
 
-
 
14977
function TD2D.RenderQuad: Boolean;
-
 
14978
begin
-
 
14979
  Result := FDDraw.D3DDevice7.DrawPrimitive(D3DPT_TRIANGLESTRIP, D3DFVF_TLVERTEX, FVertex, 4, D3DDP_WAIT) <> DD_OK;
-
 
14980
  InitVertex;
-
 
14981
  FMirrorFlipSet := []; {only for one operation, back to normal position}
-
 
14982
  {restore device status}
-
 
14983
  with FDDraw.D3DDevice7 do
-
 
14984
  begin
-
 
14985
    SetTextureStageState(1, D3DTSS_COLOROP, Ord(D3DTOP_DISABLE));
-
 
14986
    SetTextureStageState(1, D3DTSS_ALPHAOP, Ord(D3DTOP_DISABLE));
-
 
14987
    SetRenderState(D3DRENDERSTATE_ALPHABLENDENABLE, 0);
-
 
14988
  end;
-
 
14989
end;
-
 
14990
 
-
 
14991
function TD2D.RenderTri: Boolean;
-
 
14992
begin
-
 
14993
  Result := FDDraw.D3DDevice7.DrawPrimitive(D3DPT_TRIANGLESTRIP, D3DFVF_TLVERTEX, FVertex, 3, D3DDP_WAIT) <> DD_OK;
-
 
14994
  InitVertex;
-
 
14995
  FMirrorFlipSet := []; {only for one operation, back to normal position}
-
 
14996
  {restore device status}
-
 
14997
  with FDDraw.D3DDevice7 do
-
 
14998
  begin
-
 
14999
    SetTextureStageState(1, D3DTSS_COLOROP, Ord(D3DTOP_DISABLE));
-
 
15000
    SetTextureStageState(1, D3DTSS_ALPHAOP, Ord(D3DTOP_DISABLE));
-
 
15001
    SetRenderState(D3DRENDERSTATE_ALPHABLENDENABLE, 0);
-
 
15002
  end;
-
 
15003
end;
-
 
15004
 
-
 
15005
procedure TD2D.D2DMeshMapToRect(R: TRect);
-
 
15006
begin
-
 
15007
  FVertex[0].sx := R.Left - 0.5;
-
 
15008
  FVertex[0].sy := R.Top - 0.5;
-
 
15009
  FVertex[1].sx := R.Right - 0.5;
-
 
15010
  FVertex[1].sy := R.Top - 0.5;
-
 
15011
  FVertex[2].sx := R.Left - 0.5;
-
 
15012
  FVertex[2].sy := R.Bottom - 0.5;
-
 
15013
  FVertex[3].sx := R.Right - 0.5;
-
 
15014
  FVertex[3].sy := R.Bottom - 0.5;
-
 
15015
end;
-
 
15016
 
-
 
15017
function TD2D.D2DInitializeSurface: Boolean;
-
 
15018
begin
-
 
15019
  Result := False;
-
 
15020
  if Assigned(FDDraw.D3DDevice7) then
-
 
15021
    Result := FDDraw.D3DDevice7.SetRenderTarget(FDDraw.Surface.IDDSurface7, 0) = DD_OK;
-
 
15022
end;
-
 
15023
 
-
 
15024
procedure TD2D.D2DUpdateTextures;
-
 
15025
var I: Integer;
-
 
15026
begin
-
 
15027
  {$IFDEF VER4UP}
-
 
15028
  for I := Low(FD2DTexture.Texture) to High(FD2DTexture.Texture) do
-
 
15029
  {$ELSE}
-
 
15030
  for I := 0 to FD2DTexture.TexLen - 1 do
-
 
15031
  {$ENDIF}
-
 
15032
  begin
-
 
15033
    FD2DTexture.Texture[I].Width := FD2DTexture.Texture[I].D2DTexture.Surface.Width;
-
 
15034
    FD2DTexture.Texture[I].Height := FD2DTexture.Texture[I].D2DTexture.Surface.Height;
-
 
15035
//    FD2DTexture.Texture[I].AlphaChannel := ?
-
 
15036
  end;
-
 
15037
end;
-
 
15038
 
-
 
15039
{  TTrace  }
-
 
15040
 
-
 
15041
constructor TTrace.Create(Collection: TCollection);
-
 
15042
begin
-
 
15043
  inherited Create(Collection);
-
 
15044
  FBlit := TBlit.Create(Self);
-
 
15045
  FBlit.FEngine := TCustomDXDraw(Traces.FOwner);
-
 
15046
end;
-
 
15047
 
-
 
15048
destructor TTrace.Destroy;
-
 
15049
begin
-
 
15050
  FBlit.Free;
-
 
15051
  inherited Destroy;
-
 
15052
end;
-
 
15053
 
-
 
15054
function TTrace.GetDisplayName: string;
-
 
15055
begin
-
 
15056
  Result := inherited GetDisplayName
-
 
15057
end;
-
 
15058
 
-
 
15059
procedure TTrace.SetDisplayName(const Value: string);
-
 
15060
begin
-
 
15061
  if (Value <> '') and (AnsiCompareText(Value, GetDisplayName) <> 0) and
-
 
15062
    (Collection is TTraces) and (TTraces(Collection).IndexOf(Value) >= 0) then
-
 
15063
    raise Exception.Create(Format('Item duplicate name "%s" error', [Value]));
-
 
15064
  inherited SetDisplayName(Value);
-
 
15065
end;
-
 
15066
 
-
 
15067
function TTrace.GetTraces: TTraces;
-
 
15068
begin
-
 
15069
  if Collection is TTraces then
-
 
15070
    Result := TTraces(Collection)
-
 
15071
  else
-
 
15072
    Result := nil;
-
 
15073
end;
-
 
15074
 
-
 
15075
procedure TTrace.Render(const LagCount: Integer);
-
 
15076
begin
-
 
15077
  FBlit.DoMove(LagCount);
-
 
15078
  FBlit.DoCollision;
-
 
15079
  FBlit.DoDraw;
-
 
15080
  if Assigned(FBlit.FOnRender) then
-
 
15081
    FBlit.FOnRender(FBlit);
-
 
15082
end;
-
 
15083
 
-
 
15084
function TTrace.IsActualized: Boolean;
-
 
15085
begin
-
 
15086
  Result := FActualized;
-
 
15087
end;
-
 
15088
 
-
 
15089
procedure TTrace.Assign(Source: TPersistent);
-
 
15090
begin
-
 
15091
  if Source is TTrace then begin
-
 
15092
    //FTracePoints.Assign(TTrace(Source).FTracePoints);
-
 
15093
    FBlit.Assign(TTrace(Source).FBlit);
-
 
15094
    FTag := TTrace(Source).FTag;
-
 
15095
  end
-
 
15096
  else
-
 
15097
    inherited Assign(Source);
-
 
15098
end;
-
 
15099
 
-
 
15100
function TTrace.GetActive: Boolean;
-
 
15101
begin
-
 
15102
  Result := FBlit.FActive;
-
 
15103
end;
-
 
15104
 
-
 
15105
procedure TTrace.SetActive(const Value: Boolean);
-
 
15106
begin
-
 
15107
  FBlit.FActive := Value;
-
 
15108
end;
-
 
15109
 
-
 
15110
function TTrace.GetOnCollision: TNotifyEvent;
-
 
15111
begin
-
 
15112
  Result := FBlit.FOnCollision;
-
 
15113
end;
-
 
15114
 
-
 
15115
procedure TTrace.SetOnCollision(const Value: TNotifyEvent);
-
 
15116
begin
-
 
15117
  FBlit.FOnCollision := Value;
-
 
15118
end;
-
 
15119
 
-
 
15120
function TTrace.GetOnGetImage: TNotifyEvent;
-
 
15121
begin
-
 
15122
  Result := FBlit.FOnGetImage;
-
 
15123
end;
-
 
15124
 
-
 
15125
procedure TTrace.SetOnGetImage(const Value: TNotifyEvent);
-
 
15126
begin
-
 
15127
  FBlit.FOnGetImage := Value;
-
 
15128
end;
-
 
15129
 
-
 
15130
function TTrace.GetOnDraw: TNotifyEvent;
-
 
15131
begin
-
 
15132
  Result := FBlit.FOnDraw;
-
 
15133
end;
-
 
15134
 
-
 
15135
procedure TTrace.SetOnDraw(const Value: TNotifyEvent);
-
 
15136
begin
-
 
15137
  FBlit.FOnDraw := Value;
-
 
15138
end;
-
 
15139
 
-
 
15140
function TTrace.GetOnMove: TBlitMoveEvent;
-
 
15141
begin
-
 
15142
  Result := FBlit.FOnMove;
-
 
15143
end;
-
 
15144
 
-
 
15145
procedure TTrace.SetOnMove(const Value: TBlitMoveEvent);
-
 
15146
begin
-
 
15147
  FBlit.FOnMove := Value;
-
 
15148
end;
-
 
15149
 
-
 
15150
function TTrace.Clone(NewName: string; OffsetX, OffsetY: Integer;
-
 
15151
  Angle: Single): TTrace;
-
 
15152
var
-
 
15153
  NewItem: TTrace;
-
 
15154
  I: Integer;
-
 
15155
begin
-
 
15156
  NewItem := GetTraces.Add;
-
 
15157
  NewItem.Assign(Self);
-
 
15158
  NewItem.Name := NewName;
-
 
15159
  for I := 0 to NewItem.Blit.GetPathCount - 1 do begin
-
 
15160
    NewItem.Blit.FPathArr[I].X := NewItem.Blit.FPathArr[I].X + OffsetX;
-
 
15161
    NewItem.Blit.FPathArr[I].Y := NewItem.Blit.FPathArr[I].Y + OffsetY;
-
 
15162
  end;
-
 
15163
  Result := NewItem
-
 
15164
end;
-
 
15165
 
-
 
15166
function TTrace.GetOnRender: TOnRender;
-
 
15167
begin
-
 
15168
  Result := FBlit.FOnRender;
-
 
15169
end;
-
 
15170
 
-
 
15171
procedure TTrace.SetOnRender(const Value: TOnRender);
-
 
15172
begin
-
 
15173
  FBlit.FOnRender := Value;
-
 
15174
end;
-
 
15175
 
-
 
15176
{  TTraces  }
-
 
15177
 
-
 
15178
constructor TTraces.Create(AOwner: TComponent);
-
 
15179
begin
-
 
15180
  inherited Create(TTrace);
-
 
15181
  FOwner := AOwner;
-
 
15182
end;
-
 
15183
 
-
 
15184
destructor TTraces.Destroy;
-
 
15185
begin
-
 
15186
  inherited Destroy;
-
 
15187
end;
-
 
15188
 
-
 
15189
function TTraces.Add: TTrace;
-
 
15190
begin
-
 
15191
  Result := TTrace(inherited Add);
-
 
15192
end;
-
 
15193
 
-
 
15194
function TTraces.Find(const Name: string): TTrace;
-
 
15195
var
-
 
15196
  i: Integer;
-
 
15197
begin
-
 
15198
  i := IndexOf(Name);
-
 
15199
  if i = -1 then
-
 
15200
    raise EDXTracerError.CreateFmt('Tracer item named %s not found', [Name]);
-
 
15201
  Result := Items[i];
-
 
15202
end;
-
 
15203
 
-
 
15204
function TTraces.GetItem(Index: Integer): TTrace;
-
 
15205
begin
-
 
15206
  Result := TTrace(inherited GetItem(Index));
-
 
15207
end;
-
 
15208
 
-
 
15209
procedure TTraces.SetItem(Index: Integer;
-
 
15210
  Value: TTrace);
-
 
15211
begin
-
 
15212
  inherited SetItem(Index, Value);
-
 
15213
end;
-
 
15214
 
-
 
15215
procedure TTraces.Update(Item: TCollectionItem);
-
 
15216
begin
-
 
15217
  inherited Update(Item);
-
 
15218
end;
-
 
15219
 
-
 
15220
{$IFDEF VER4UP}
-
 
15221
function TTraces.Insert(Index: Integer): TTrace;
-
 
15222
begin
-
 
15223
  Result := TTrace(inherited Insert(Index));
-
 
15224
end;
-
 
15225
{$ENDIF}
-
 
15226
 
-
 
15227
function TTraces.GetOwner: TPersistent;
-
 
15228
begin
-
 
15229
  Result := FOwner;
-
 
15230
end;
-
 
15231
 
-
 
15232
{  TBlit  }
-
 
15233
 
-
 
15234
function TBlit.GetWorldX: Double;
-
 
15235
begin
-
 
15236
  if Parent <> nil then
-
 
15237
    Result := Parent.WorldX + FBlitRec.FX
-
 
15238
  else
-
 
15239
    Result := FBlitRec.FX;
-
 
15240
end;
-
 
15241
 
-
 
15242
function TBlit.GetWorldY: Double;
-
 
15243
begin
-
 
15244
  if Parent <> nil then
-
 
15245
    Result := Parent.WorldY + FBlitRec.FY
-
 
15246
  else
-
 
15247
    Result := FBlitRec.FY;
-
 
15248
end;
-
 
15249
 
-
 
15250
procedure TBlit.DoMove(LagCount: Integer);
-
 
15251
var
-
 
15252
  MoveIt: Boolean;
-
 
15253
begin
-
 
15254
  if not FBlitRec.FMoved then Exit;
-
 
15255
  if AsSigned(FOnMove) then begin
-
 
15256
    MoveIt := True; {if nothing then reanimate will force}
-
 
15257
    FOnMove(Self, LagCount, MoveIt); {when returned MoveIt = true still that do not move}
-
 
15258
    if MoveIt then
-
 
15259
      ReAnimate(LagCount); //for reanimation
-
 
15260
  end
-
 
15261
  else begin
-
 
15262
    ReAnimate(LagCount);
-
 
15263
  end;
-
 
15264
  {there is moving to next foot of the path}
-
 
15265
  if Active then
-
 
15266
    if GetPathCount > 0 then begin
-
 
15267
      Dec(FCurrentTime, LagCount);
-
 
15268
      if FCurrentTime < 0 then begin
-
 
15269
        if FBustrofedon then begin
-
 
15270
          case FCurrentDirection of
-
 
15271
            True: begin
-
 
15272
                Inc(FCurrentPosition); //go forward
-
 
15273
                if FCurrentPosition = (GetPathCount - 1) then
-
 
15274
                  FCurrentDirection := not FCurrentDirection //change direction
-
 
15275
              end;
-
 
15276
            False: begin
-
 
15277
                Dec(FCurrentPosition); //go backward
-
 
15278
                if FCurrentPosition = 0 then
-
 
15279
                  FCurrentDirection := not FCurrentDirection //change direction
-
 
15280
              end;
-
 
15281
          end;
-
 
15282
        end
-
 
15283
        else
-
 
15284
          if FCurrentPosition < (GetPathCount - 1) then begin
-
 
15285
            Inc(FCurrentPosition) //go forward only
-
 
15286
          end
-
 
15287
          else
-
 
15288
            if FMovingRepeatly then
-
 
15289
              FCurrentPosition := 0; {return to start}
-
 
15290
        {get actual new value for showing time}
-
 
15291
        {must be pick-up there, after change of the current position}
-
 
15292
        FCurrentTime := Path[FCurrentPosition].StayOn; {cas mezi pohyby}
-
 
15293
      end;
-
 
15294
      X := Path[FCurrentPosition].X;
-
 
15295
      Y := Path[FCurrentPosition].Y;
-
 
15296
    end;
-
 
15297
  {}
-
 
15298
end;
-
 
15299
 
-
 
15300
function TBlit.GetDrawImageIndex: Integer;
-
 
15301
begin
-
 
15302
  Result := FBlitRec.FAnimStart + Trunc(FBlitRec.FAnimPos);
-
 
15303
end;
-
 
15304
 
-
 
15305
procedure TBlit.DoDraw;
-
 
15306
var
-
 
15307
  f: TRenderMirrorFlipSet;
-
 
15308
  r: TRect;
-
 
15309
begin
-
 
15310
  with FBlitRec do begin
-
 
15311
    if not FVisible then Exit;
-
 
15312
    if FImage = nil then DoGetImage;
-
 
15313
    if FImage = nil then Exit;
-
 
15314
    {owner draw called here}
-
 
15315
    if AsSigned(FOnDraw) then
-
 
15316
      FOnDraw(Self)
-
 
15317
    else
-
 
15318
    {when is not owner draw then go here}
-
 
15319
    begin
-
 
15320
      f := [];
-
 
15321
      if FMirror then f := f + [rmfMirror];
-
 
15322
      if FFlip then f := f + [rmfFlip];
-
 
15323
      r := Bounds(Round(FX), Round(FY), FImage.Width, FImage.Height);
-
 
15324
      DXDraw_Render(FEngine, FImage, r,
-
 
15325
        GetDrawImageIndex, FBlurImageArr, FBlurImage, FTextureFilter, f, FBlendMode, FAngle,
-
 
15326
        FAlpha, FCenterX, FCenterY, FScale, FWaveType, FAmplitude, FAmpLength, FPhase);
-
 
15327
    end;
-
 
15328
  end
-
 
15329
end;
-
 
15330
 
-
 
15331
function Mod2f(i: Double; i2: Integer): Double;
-
 
15332
begin
-
 
15333
  if i2 = 0 then
-
 
15334
    Result := i
-
 
15335
  else
-
 
15336
  begin
-
 
15337
    Result := i - Round(i / i2) * i2;
-
 
15338
    if Result < 0 then
-
 
15339
      Result := i2 + Result;
-
 
15340
  end;
-
 
15341
end;
-
 
15342
 
-
 
15343
procedure TBlit.ReAnimate(MoveCount: Integer);
-
 
15344
var I: Integer;
-
 
15345
begin
-
 
15346
  with FBlitRec do begin
-
 
15347
    FAnimPos := FAnimPos + FAnimSpeed * MoveCount;
-
 
15348
 
-
 
15349
    if FAnimLooped then
-
 
15350
    begin
-
 
15351
      if FAnimCount > 0 then
-
 
15352
        FAnimPos := Mod2f(FAnimPos, FAnimCount)
-
 
15353
      else
-
 
15354
        FAnimPos := 0;
-
 
15355
    end
-
 
15356
    else
-
 
15357
    begin
-
 
15358
      if Round(FAnimPos) >= FAnimCount then
-
 
15359
      begin
-
 
15360
        FAnimPos := FAnimCount - 1;
-
 
15361
        FAnimSpeed := 0;
-
 
15362
      end;
-
 
15363
      if FAnimPos < 0 then
-
 
15364
      begin
-
 
15365
        FAnimPos := 0;
-
 
15366
        FAnimSpeed := 0;
-
 
15367
      end;
-
 
15368
    end;
-
 
15369
    {incerease or decrease speed}
-
 
15370
    if (FEnergy <> 0) then begin
-
 
15371
      FSpeedX := FSpeedX + FSpeedX * FEnergy;
-
 
15372
      FSpeedY := FSpeedY + FSpeedY * FEnergy;
-
 
15373
    end;
-
 
15374
    {adjust with speed}
-
 
15375
    if (FSpeedX > 0) or (FSpeedY > 0) then begin
-
 
15376
      FX := FX + FSpeedX * MoveCount;
-
 
15377
      FY := FY + FSpeedY * MoveCount;
-
 
15378
    end;
-
 
15379
    {and gravity aplicable}
-
 
15380
    if (FGravityX > 0) or (FGravityY > 0) then begin
-
 
15381
      FX := FX + FGravityX * MoveCount;
-
 
15382
      FY := FY + FGravityY * MoveCount;
-
 
15383
    end;
-
 
15384
    if FBlurImage then begin
-
 
15385
      {ale jen jsou-li jine souradnice}
-
 
15386
      if (FBlurImageArr[High(FBlurImageArr)].eX <> Round(WorldX)) or
-
 
15387
      (FBlurImageArr[High(FBlurImageArr)].eY <> Round(WorldY)) then begin
-
 
15388
        for i := Low(FBlurImageArr) + 1 to High(FBlurImageArr) do begin
-
 
15389
          FBlurImageArr[i - 1] := FBlurImageArr[i];
-
 
15390
          {adjust the blur intensity}
-
 
15391
          FBlurImageArr[i - 1].eIntensity := Round(FAlpha / (High(FBlurImageArr) + 1)) * (i - 1);
-
 
15392
        end;
-
 
15393
        with FBlurImageArr[High(FBlurImageArr)] do begin
-
 
15394
          eX := Round(WorldX);
-
 
15395
          eY := Round(WorldY);
-
 
15396
          ePatternIndex := GetDrawImageIndex;
-
 
15397
          eIntensity := Round(FAlpha / (High(FBlurImageArr) + 1)) * High(FBlurImageArr);
-
 
15398
          eBlendMode := FBlendMode;
-
 
15399
          eActive := True;
-
 
15400
        end;
-
 
15401
      end;
-
 
15402
    end;
7067
  end;
15403
  end;
7068
end;
15404
end;
7069
 
15405
 
-
 
15406
function TBlit.DoCollision: TBlit;
-
 
15407
var
-
 
15408
  i, maxzaxis: Integer;
-
 
15409
begin
-
 
15410
  Result := nil;
-
 
15411
  if not FBlitRec.FCollisioned then Exit;
-
 
15412
  if AsSigned(FOnCollision) then
-
 
15413
    FOnCollision(Self)
-
 
15414
  else begin
-
 
15415
    {over z axis}
-
 
15416
    maxzaxis := 0;
-
 
15417
    for i := 0 to FEngine.Traces.Count - 1 do
-
 
15418
      maxzaxis := Max(maxzaxis, FEngine.Traces.Items[i].FBlit.Z);
-
 
15419
    {for all items}
-
 
15420
    for i := 0 to FEngine.Traces.Count - 1 do
-
 
15421
      {no self item}
-
 
15422
      if FEngine.Traces.Items[i].FBlit <> Self then
-
 
15423
        {through engine}
-
 
15424
        with FEngine.Traces.Items[i] do
-
 
15425
          {test overlap}
-
 
15426
          if OverlapRect(Bounds(Round(FBlit.WorldX), Round(FBlit.WorldY),
-
 
15427
            FBlit.Width, FBlit.Height), Bounds(Round(WorldX), Round(WorldY), Width, Height)) then
-
 
15428
          begin
-
 
15429
            {if any, then return first blit}
-
 
15430
            Result := FBlit;
-
 
15431
            {and go out}
-
 
15432
            Break;
-
 
15433
          end;
-
 
15434
  end;
-
 
15435
end;
-
 
15436
 
-
 
15437
procedure TBlit.DoGetImage;
-
 
15438
begin
-
 
15439
  {init image when object come from form}
-
 
15440
  if FImage = nil then
-
 
15441
    if AsSigned(FOnGetImage) then begin
-
 
15442
      FOnGetImage(Self);
-
 
15443
      if FImage = nil then
-
 
15444
        raise EDXBlitError.Create('Undefined image file!');
-
 
15445
      FBlitRec.FWidth := FImage.Width;
-
 
15446
      FBlitRec.FHeight := FImage.Height;
-
 
15447
    end;
-
 
15448
end;
-
 
15449
 
-
 
15450
constructor TBlit.Create(AParent: TObject);
-
 
15451
begin
-
 
15452
  inherited Create;
-
 
15453
  FParent := nil;
-
 
15454
  if AParent is TBlit then
-
 
15455
    FParent := TBlit(AParent);
-
 
15456
  FillChar(FBlitRec, SizeOf(FBlitRec), 0);
-
 
15457
  with FBlitRec do begin
-
 
15458
    FCollisioned := True; {can be collisioned}
-
 
15459
    FMoved := True; {can be moved}
-
 
15460
    FVisible := True; {can be rendered}
-
 
15461
    FAnimCount := 0;
-
 
15462
    FAnimLooped := False;
-
 
15463
    FAnimPos := 0;
-
 
15464
    FAnimSpeed := 0;
-
 
15465
    FAnimStart := 0;
-
 
15466
    FAngle := 0;
-
 
15467
    FAlpha := $FF;
-
 
15468
    FCenterX := 0.5;
-
 
15469
    FCenterY := 0.5;
-
 
15470
    FScale := 1;
-
 
15471
    FBlendMode := rtDraw;
-
 
15472
    FAmplitude := 0;
-
 
15473
    FAmpLength := 0;
-
 
15474
    FPhase := 0;
-
 
15475
    FWaveType := wtWaveNone;
-
 
15476
    FSpeedX := 0;
-
 
15477
    FSpeedY := 0;
-
 
15478
    FGravityX := 0;
-
 
15479
    FGravityY := 0;
-
 
15480
    FEnergy := 0;
-
 
15481
    FBlurImage := False;
-
 
15482
    FMirror := False;
-
 
15483
    FFlip := False;
-
 
15484
  end;
-
 
15485
  FillChar(FBlurImageArr, SizeOf(FBlitRec), 0);
-
 
15486
  FActive := True; {active on}
-
 
15487
  FMovingRepeatly := True;
-
 
15488
  {super private}
-
 
15489
  FCurrentTime := 0;
-
 
15490
  FCurrentPosition := 0;
-
 
15491
  FCurrentDirection := True;
-
 
15492
end;
-
 
15493
 
-
 
15494
destructor TBlit.Destroy;
-
 
15495
begin
-
 
15496
  {$IFDEF VER4UP}
-
 
15497
  SetLength(FPathArr, 0);
-
 
15498
  {$ELSE}
-
 
15499
  SetPathLen(0);
-
 
15500
  {$ENDIF}
-
 
15501
  inherited;
-
 
15502
end;
-
 
15503
 
-
 
15504
function TBlit.GetMoved: Boolean;
-
 
15505
begin
-
 
15506
  Result := FBlitRec.FMoved;
-
 
15507
end;
-
 
15508
 
-
 
15509
procedure TBlit.SetMoved(const Value: Boolean);
-
 
15510
begin
-
 
15511
  FBlitRec.FMoved := Value;
-
 
15512
end;
-
 
15513
 
-
 
15514
function TBlit.GetWaveType: TWaveType;
-
 
15515
begin
-
 
15516
  Result := FBlitRec.FWaveType;
-
 
15517
end;
-
 
15518
 
-
 
15519
procedure TBlit.SetWaveType(const Value: TWaveType);
-
 
15520
begin
-
 
15521
  FBlitRec.FWaveType := Value;
-
 
15522
end;
-
 
15523
 
-
 
15524
function TBlit.GetAmplitude: Integer;
-
 
15525
begin
-
 
15526
  Result := FBlitRec.FAmplitude;
-
 
15527
end;
-
 
15528
 
-
 
15529
procedure TBlit.SetAmplitude(const Value: Integer);
-
 
15530
begin
-
 
15531
  FBlitRec.FAmplitude := Value;
-
 
15532
end;
-
 
15533
 
-
 
15534
function TBlit.GetAnimStart: Integer;
-
 
15535
begin
-
 
15536
  Result := FBlitRec.FAnimStart;
-
 
15537
end;
-
 
15538
 
-
 
15539
procedure TBlit.SetAnimStart(const Value: Integer);
-
 
15540
begin
-
 
15541
  FBlitRec.FAnimStart := Value;
-
 
15542
end;
-
 
15543
 
-
 
15544
function TBlit.GetAmpLength: Integer;
-
 
15545
begin
-
 
15546
  Result := FBlitRec.FAmpLength;
-
 
15547
end;
-
 
15548
 
-
 
15549
procedure TBlit.SetAmpLength(const Value: Integer);
-
 
15550
begin
-
 
15551
  FBlitRec.FAmpLength := Value;
-
 
15552
end;
-
 
15553
 
-
 
15554
function TBlit.GetWidth: Integer;
-
 
15555
begin
-
 
15556
  Result := FBlitRec.FWidth;
-
 
15557
end;
-
 
15558
 
-
 
15559
procedure TBlit.SetWidth(const Value: Integer);
-
 
15560
begin
-
 
15561
  FBlitRec.FWidth := Value;
-
 
15562
end;
-
 
15563
 
-
 
15564
function TBlit.GetGravityX: Single;
-
 
15565
begin
-
 
15566
  Result := FBlitRec.FGravityX;
-
 
15567
end;
-
 
15568
 
-
 
15569
procedure TBlit.SetGravityX(const Value: Single);
-
 
15570
begin
-
 
15571
  FBlitRec.FGravityX := Value;
-
 
15572
end;
-
 
15573
 
-
 
15574
function TBlit.StoreGravityX: Boolean;
-
 
15575
begin
-
 
15576
  Result := FBlitRec.FGravityX <> 1.0;
-
 
15577
end;
-
 
15578
 
-
 
15579
function TBlit.GetPhase: Integer;
-
 
15580
begin
-
 
15581
  Result := FBlitRec.FPhase;
-
 
15582
end;
-
 
15583
 
-
 
15584
procedure TBlit.SetPhase(const Value: Integer);
-
 
15585
begin
-
 
15586
  FBlitRec.FPhase := Value;
-
 
15587
end;
-
 
15588
 
-
 
15589
function TBlit.GetAnimPos: Double;
-
 
15590
begin
-
 
15591
  Result := FBlitRec.FAnimPos;
-
 
15592
end;
-
 
15593
 
-
 
15594
procedure TBlit.SetAnimPos(const Value: Double);
-
 
15595
begin
-
 
15596
  FBlitRec.FAnimPos := Value;
-
 
15597
end;
-
 
15598
 
-
 
15599
function TBlit.StoreAnimPos: Boolean;
-
 
15600
begin
-
 
15601
  Result := FBlitRec.FAnimPos <> 0;
-
 
15602
end;
-
 
15603
 
-
 
15604
function TBlit.GetFlip: Boolean;
-
 
15605
begin
-
 
15606
  Result := FBlitRec.FFlip;
-
 
15607
end;
-
 
15608
 
-
 
15609
procedure TBlit.SetFlip(const Value: Boolean);
-
 
15610
begin
-
 
15611
  FBlitRec.FFlip := Value;
-
 
15612
end;
-
 
15613
 
-
 
15614
function TBlit.GetGravityY: Single;
-
 
15615
begin
-
 
15616
  Result := FBlitRec.FGravityY;
-
 
15617
end;
-
 
15618
 
-
 
15619
procedure TBlit.SetGravityY(const Value: Single);
-
 
15620
begin
-
 
15621
  FBlitRec.FGravityY := Value;
-
 
15622
end;
-
 
15623
 
-
 
15624
function TBlit.StoreGravityY: Boolean;
-
 
15625
begin
-
 
15626
  Result := FBlitRec.FGravityY <> 1.0;
-
 
15627
end;
-
 
15628
 
-
 
15629
function TBlit.GetSpeedX: Single;
-
 
15630
begin
-
 
15631
  Result := FBlitRec.FSpeedX;
-
 
15632
end;
-
 
15633
 
-
 
15634
procedure TBlit.SetSpeedX(const Value: Single);
-
 
15635
begin
-
 
15636
  FBlitRec.FSpeedX := Value;
-
 
15637
end;
-
 
15638
 
-
 
15639
function TBlit.StoreSpeedX: Boolean;
-
 
15640
begin
-
 
15641
  Result := FBlitRec.FSpeedX <> 0;
-
 
15642
end;
-
 
15643
 
-
 
15644
function TBlit.GetSpeedY: Single;
-
 
15645
begin
-
 
15646
  Result := FBlitRec.FSpeedY;
-
 
15647
end;
-
 
15648
 
-
 
15649
procedure TBlit.SetSpeedY(const Value: Single);
-
 
15650
begin
-
 
15651
  FBlitRec.FSpeedY := Value;
-
 
15652
end;
-
 
15653
 
-
 
15654
function TBlit.StoreSpeedY: Boolean;
-
 
15655
begin
-
 
15656
  Result := FBlitRec.FSpeedY <> 0;
-
 
15657
end;
-
 
15658
 
-
 
15659
function TBlit.GetCenterX: Double;
-
 
15660
begin
-
 
15661
  Result := FBlitRec.FCenterX;
-
 
15662
end;
-
 
15663
 
-
 
15664
procedure TBlit.SetCenterX(const Value: Double);
-
 
15665
begin
-
 
15666
  FBlitRec.FCenterX := Value;
-
 
15667
end;
-
 
15668
 
-
 
15669
function TBlit.StoreCenterX: Boolean;
-
 
15670
begin
-
 
15671
  Result := FBlitRec.FCenterX <> 0.5;
-
 
15672
end;
-
 
15673
 
-
 
15674
function TBlit.GetAngle: Single;
-
 
15675
begin
-
 
15676
  Result := FBlitRec.FAngle;
-
 
15677
end;
-
 
15678
 
-
 
15679
procedure TBlit.SetAngle(const Value: Single);
-
 
15680
begin
-
 
15681
  FBlitRec.FAngle := Value;
-
 
15682
end;
-
 
15683
 
-
 
15684
function TBlit.StoreAngle: Boolean;
-
 
15685
begin
-
 
15686
  Result := FBlitRec.FAngle <> 0;
-
 
15687
end;
-
 
15688
 
-
 
15689
function TBlit.GetBlurImage: Boolean;
-
 
15690
begin
-
 
15691
  Result := FBlitRec.FBlurImage;
-
 
15692
end;
-
 
15693
 
-
 
15694
procedure TBlit.SetBlurImage(const Value: Boolean);
-
 
15695
begin
-
 
15696
  FBlitRec.FBlurImage := Value;
-
 
15697
end;
-
 
15698
 
-
 
15699
function TBlit.GetCenterY: Double;
-
 
15700
begin
-
 
15701
  Result := FBlitRec.FCenterY;
-
 
15702
end;
-
 
15703
 
-
 
15704
procedure TBlit.SetCenterY(const Value: Double);
-
 
15705
begin
-
 
15706
  FBlitRec.FCenterY := Value;
-
 
15707
end;
-
 
15708
 
-
 
15709
function TBlit.StoreCenterY: Boolean;
-
 
15710
begin
-
 
15711
  Result := FBlitRec.FCenterY <> 0.5;
-
 
15712
end;
-
 
15713
 
-
 
15714
function TBlit.GetBlendMode: TRenderType;
-
 
15715
begin
-
 
15716
  Result := FBlitRec.FBlendMode;
-
 
15717
end;
-
 
15718
 
-
 
15719
procedure TBlit.SetBlendMode(const Value: TRenderType);
-
 
15720
begin
-
 
15721
  FBlitRec.FBlendMode := Value;
-
 
15722
end;
-
 
15723
 
-
 
15724
function TBlit.GetAnimSpeed: Double;
-
 
15725
begin
-
 
15726
  Result := FBlitRec.FAnimSpeed;
-
 
15727
end;
-
 
15728
 
-
 
15729
procedure TBlit.SetAnimSpeed(const Value: Double);
-
 
15730
begin
-
 
15731
  FBlitRec.FAnimSpeed := Value;
-
 
15732
end;
-
 
15733
 
-
 
15734
function TBlit.StoreAnimSpeed: Boolean;
-
 
15735
begin
-
 
15736
  Result := FBlitRec.FAnimSpeed <> 0;
-
 
15737
end;
-
 
15738
 
-
 
15739
function TBlit.GetZ: Integer;
-
 
15740
begin
-
 
15741
  Result := FBlitRec.FZ;
-
 
15742
end;
-
 
15743
 
-
 
15744
procedure TBlit.SetZ(const Value: Integer);
-
 
15745
begin
-
 
15746
  FBlitRec.FZ := Value;
-
 
15747
end;
-
 
15748
 
-
 
15749
function TBlit.GetMirror: Boolean;
-
 
15750
begin
-
 
15751
  Result := FBlitRec.FMirror;
-
 
15752
end;
-
 
15753
 
-
 
15754
procedure TBlit.SetMirror(const Value: Boolean);
-
 
15755
begin
-
 
15756
  FBlitRec.FMirror := Value;
-
 
15757
end;
-
 
15758
 
-
 
15759
function TBlit.GetX: Double;
-
 
15760
begin
-
 
15761
  Result := FBlitRec.FX;
-
 
15762
end;
-
 
15763
 
-
 
15764
procedure TBlit.SetX(const Value: Double);
-
 
15765
begin
-
 
15766
  FBlitRec.FX := Value;
-
 
15767
end;
-
 
15768
 
-
 
15769
function TBlit.GetVisible: Boolean;
-
 
15770
begin
-
 
15771
  Result := FBlitRec.FVisible;
-
 
15772
end;
-
 
15773
 
-
 
15774
procedure TBlit.SetVisible(const Value: Boolean);
-
 
15775
begin
-
 
15776
  FBlitRec.FVisible := Value;
-
 
15777
end;
-
 
15778
 
-
 
15779
function TBlit.GetY: Double;
-
 
15780
begin
-
 
15781
  Result := FBlitRec.FY;
-
 
15782
end;
-
 
15783
 
-
 
15784
procedure TBlit.SetY(const Value: Double);
-
 
15785
begin
-
 
15786
  FBlitRec.FY := Value;
-
 
15787
end;
-
 
15788
 
-
 
15789
function TBlit.GetAlpha: Byte;
-
 
15790
begin
-
 
15791
  Result := FBlitRec.FAlpha;
-
 
15792
end;
-
 
15793
 
-
 
15794
procedure TBlit.SetAlpha(const Value: Byte);
-
 
15795
begin
-
 
15796
  FBlitRec.FAlpha := Value;
-
 
15797
end;
-
 
15798
 
-
 
15799
function TBlit.GetEnergy: Single;
-
 
15800
begin
-
 
15801
  Result := FBlitRec.FEnergy;
-
 
15802
end;
-
 
15803
 
-
 
15804
procedure TBlit.SetEnergy(const Value: Single);
-
 
15805
begin
-
 
15806
  FBlitRec.FEnergy := Value;
-
 
15807
end;
-
 
15808
 
-
 
15809
function TBlit.StoreEnergy: Boolean;
-
 
15810
begin
-
 
15811
  Result := FBlitRec.FEnergy <> 0;
-
 
15812
end;
-
 
15813
 
-
 
15814
function TBlit.GetCollisioned: Boolean;
-
 
15815
begin
-
 
15816
  Result := FBlitRec.FCollisioned;
-
 
15817
end;
-
 
15818
 
-
 
15819
procedure TBlit.SetCollisioned(const Value: Boolean);
-
 
15820
begin
-
 
15821
  FBlitRec.FCollisioned := Value;
-
 
15822
end;
-
 
15823
 
-
 
15824
function TBlit.GetAnimLooped: Boolean;
-
 
15825
begin
-
 
15826
  Result := FBlitRec.FAnimLooped;
-
 
15827
end;
-
 
15828
 
-
 
15829
procedure TBlit.SetAnimLooped(const Value: Boolean);
-
 
15830
begin
-
 
15831
  FBlitRec.FAnimLooped := Value;
-
 
15832
end;
-
 
15833
 
-
 
15834
function TBlit.GetHeight: Integer;
-
 
15835
begin
-
 
15836
  Result := FBlitRec.FHeight;
-
 
15837
end;
-
 
15838
 
-
 
15839
procedure TBlit.SetHeight(const Value: Integer);
-
 
15840
begin
-
 
15841
  FBlitRec.FHeight := Value;
-
 
15842
end;
-
 
15843
 
-
 
15844
function TBlit.GetScale: Double;
-
 
15845
begin
-
 
15846
  Result := FBlitRec.FScale;
-
 
15847
end;
-
 
15848
 
-
 
15849
procedure TBlit.SetScale(const Value: Double);
-
 
15850
begin
-
 
15851
  FBlitRec.FScale := Value;
-
 
15852
end;
-
 
15853
 
-
 
15854
function TBlit.StoreScale: Boolean;
-
 
15855
begin
-
 
15856
  Result := FBlitRec.FScale <> 1.0;
-
 
15857
end;
-
 
15858
 
-
 
15859
function TBlit.GetAnimCount: Integer;
-
 
15860
begin
-
 
15861
  Result := FBlitRec.FAnimCount;
-
 
15862
end;
-
 
15863
 
-
 
15864
procedure TBlit.SetAnimCount(const Value: Integer);
-
 
15865
begin
-
 
15866
  FBlitRec.FAnimCount := Value;
-
 
15867
end;
-
 
15868
 
-
 
15869
function TBlit.GetTextureFilter: TD2DTextureFilter;
-
 
15870
begin
-
 
15871
  Result := FBlitRec.FTextureFilter;
-
 
15872
end;
-
 
15873
 
-
 
15874
procedure TBlit.SetTextureFilter(const Value: TD2DTextureFilter);
-
 
15875
begin
-
 
15876
  FBlitRec.FTextureFilter := Value;
-
 
15877
end;
-
 
15878
 
-
 
15879
function TBlit.GetBoundsRect: TRect;
-
 
15880
begin
-
 
15881
  Result := Bounds(Round(WorldX), Round(WorldY), Width, Height);
-
 
15882
end;
-
 
15883
 
-
 
15884
function TBlit.GetClientRect: TRect;
-
 
15885
begin
-
 
15886
  Result := Bounds(0, 0, Width, Height);
-
 
15887
end;
-
 
15888
 
-
 
15889
function TBlit.GetBlitAt(X, Y: Integer): TBlit;
-
 
15890
 
-
 
15891
  procedure BlitAt(X, Y: Double; Blit: TBlit);
-
 
15892
  var
-
 
15893
    i: Integer;
-
 
15894
    X2, Y2: Double;
-
 
15895
  begin
-
 
15896
    if Blit.Visible and PointInRect(Point(Round(X), Round(Y)),
-
 
15897
      Bounds(Round(Blit.X), Round(Blit.Y), Blit.Width, Blit.Width)) then
-
 
15898
    begin
-
 
15899
      if (Result = nil) or (Blit.Z > Result.Z) then
-
 
15900
        Result := Blit; {uniquelly - where will be store last blit}
-
 
15901
    end;
-
 
15902
 
-
 
15903
    X2 := X - Blit.X;
-
 
15904
    Y2 := Y - Blit.Y;
-
 
15905
    for i := 0 to Blit.Engine.FTraces.Count - 1 do
-
 
15906
      BlitAt(X2, Y2, Blit.Engine.FTraces.Items[i].FBlit);
-
 
15907
  end;
-
 
15908
 
-
 
15909
var
-
 
15910
  i: Integer;
-
 
15911
  X2, Y2: Double;
-
 
15912
begin
-
 
15913
  Result := nil;
-
 
15914
 
-
 
15915
  X2 := X - Self.X;
-
 
15916
  Y2 := Y - Self.Y;
-
 
15917
  for i := 0 to Engine.FTraces.Count - 1 do
-
 
15918
    BlitAt(X2, Y2, Engine.FTraces.Items[i].FBlit);
-
 
15919
end;
-
 
15920
 
-
 
15921
procedure TBlit.SetPathLen(Len: Integer);
-
 
15922
var I, L: Integer;
-
 
15923
begin
-
 
15924
  {$IFDEF VER4UP}
-
 
15925
  if Length(FPathArr) <> Len then
-
 
15926
  {$ELSE}
-
 
15927
  if FPathLen <> Len then
-
 
15928
  {$ENDIF}
-
 
15929
  begin
-
 
15930
    L := Len;
-
 
15931
    if Len <= 0 then L := 0;
-
 
15932
    {$IFDEF VER4UP}
-
 
15933
    SetLength(FPathArr, L);
-
 
15934
    for I := Low(FPathArr) to High(FPathArr) do begin
-
 
15935
      FillChar(FPathArr[i], SizeOf(FPathArr), 0);
-
 
15936
      FPathArr[i].StayOn := 25;
-
 
15937
    end;
-
 
15938
    {$ELSE}
-
 
15939
    FPathLen := L;
-
 
15940
    if FPathArr = nil then
-
 
15941
      FPAthArr := AllocMem(FPathLen * SizeOf(TPath))
-
 
15942
    else
-
 
15943
      {alokuj pamet}
-
 
15944
      ReallocMem(FPathArr, FPathLen * SizeOf(TPath));
-
 
15945
    if Assigned(FPathArr) then begin
-
 
15946
      FillChar(FPathArr^, FPathLen * SizeOf(TPath), 0);
-
 
15947
      for I := 0 to FPathLen do
-
 
15948
        FPathArr[i].StayOn := 25;
-
 
15949
    end
-
 
15950
    {$ENDIF}
-
 
15951
  end;
-
 
15952
end;
-
 
15953
 
-
 
15954
function TBlit.IsPathEmpty: Boolean;
-
 
15955
begin
-
 
15956
  {$IFNDEF VER4UP}
-
 
15957
  Result := FPathLen = 0;
-
 
15958
  {$ELSE}
-
 
15959
  Result := Length(FPathArr) = 0;
-
 
15960
  {$ENDIF}
-
 
15961
end;
-
 
15962
 
-
 
15963
function TBlit.GetPathCount: Integer;
-
 
15964
begin
-
 
15965
  {$IFNDEF VER4UP}
-
 
15966
  Result := FPathLen;
-
 
15967
  {$ELSE}
-
 
15968
  Result := Length(FPathArr);
-
 
15969
  {$ENDIF}
-
 
15970
end;
-
 
15971
 
-
 
15972
function TBlit.GetPath(index: Integer): TPath;
-
 
15973
begin
-
 
15974
  {$IFDEF VER4UP}
-
 
15975
  if (index >= Low(FPathArr)) and (index <= High(FPathArr)) then
-
 
15976
  {$ELSE}
-
 
15977
  if (index >= 0) and (index < FPathLen) then
-
 
15978
  {$ENDIF}
-
 
15979
    Result := FPathArr[index]
-
 
15980
  else
-
 
15981
    raise Exception.Create('Bad path index!');
-
 
15982
end;
-
 
15983
 
-
 
15984
procedure TBlit.SetPath(index: Integer; const Value: TPath);
-
 
15985
begin
-
 
15986
  {$IFDEF VER4UP}
-
 
15987
  if (index >= Low(FPathArr)) and (index <= High(FPathArr)) then
-
 
15988
  {$ELSE}
-
 
15989
  if (index >= 0) and (index < FPathLen) then
-
 
15990
  {$ENDIF}
-
 
15991
    FPathArr[index] := Value
-
 
15992
  else
-
 
15993
    raise Exception.Create('Bad path index!');
-
 
15994
end;
-
 
15995
 
-
 
15996
procedure TBlit.ReadPaths(Stream: TStream);
-
 
15997
var
-
 
15998
  PathLen: Integer;
-
 
15999
begin
-
 
16000
  {nacti delku}
-
 
16001
  Stream.ReadBuffer(PathLen, SizeOf(PathLen));
-
 
16002
  SetPathLen(PathLen);
-
 
16003
  Stream.ReadBuffer(FPathArr[0], PathLen * SizeOf(TPath));
-
 
16004
end;
-
 
16005
 
-
 
16006
procedure TBlit.WritePaths(Stream: TStream);
-
 
16007
var
-
 
16008
  PathLen: Integer;
-
 
16009
begin
-
 
16010
  PathLen := GetPathCount;
-
 
16011
  Stream.WriteBuffer(PathLen, SizeOf(PathLen));
-
 
16012
  Stream.WriteBuffer(FPathArr[0], PathLen * SizeOf(TPath));
-
 
16013
end;
-
 
16014
 
-
 
16015
procedure TBlit.DefineProperties(Filer: TFiler);
-
 
16016
begin
-
 
16017
  inherited DefineProperties(Filer);
-
 
16018
  Filer.DefineBinaryProperty('Paths', ReadPaths, WritePaths, not IsPathEmpty);
-
 
16019
end;
-
 
16020
 
-
 
16021
procedure TBlit.Assign(Source: TPersistent);
-
 
16022
var I: Integer;
-
 
16023
begin
-
 
16024
  if Source is TBlit then
-
 
16025
  begin
-
 
16026
    {$IFDEF VER4UP}
-
 
16027
    I := Length(TBlit(Source).FPathArr);
-
 
16028
    {$ELSE}
-
 
16029
    I := FPathLen;
-
 
16030
    {$ENDIF}
-
 
16031
    SetPathLen(I);
-
 
16032
    if I > 0 then
-
 
16033
      Move(TBlit(Source).FPathArr[0], FPathArr[0], I * SizeOf(TPath));
-
 
16034
    FBlitRec := TBlit(Source).FBlitRec;
-
 
16035
    FillChar(FBlurImageArr, SizeOf(FBlurImageArr), 0);
-
 
16036
    FActive := TBlit(Source).FActive;
-
 
16037
    FMovingRepeatly := TBlit(Source).FMovingRepeatly;
-
 
16038
    FImage := nil;
-
 
16039
    FOnMove := TBlit(Source).FOnMove;
-
 
16040
    FOnDraw := TBlit(Source).FOnDraw;
-
 
16041
    FOnCollision := TBlit(Source).FOnCollision;
-
 
16042
    FOnGetImage := TBlit(Source).FOnGetImage;
-
 
16043
    FEngine := TBlit(Source).FEngine;
-
 
16044
  end
-
 
16045
  else
-
 
16046
    inherited Assign(Source);
-
 
16047
end;
-
 
16048
 
-
 
16049
function TBlit.GetMovingRepeatly: Boolean;
-
 
16050
begin
-
 
16051
  Result := FMovingRepeatly;
-
 
16052
end;
-
 
16053
 
-
 
16054
procedure TBlit.SetMovingRepeatly(const Value: Boolean);
-
 
16055
begin
-
 
16056
  FMovingRepeatly := Value;
-
 
16057
end;
-
 
16058
 
-
 
16059
function TBlit.GetBustrofedon: Boolean;
-
 
16060
begin
-
 
16061
  Result := FBustrofedon;
-
 
16062
end;
-
 
16063
 
-
 
16064
procedure TBlit.SetBustrofedon(const Value: Boolean);
-
 
16065
begin
-
 
16066
  FBustrofedon := Value;
-
 
16067
end;
-
 
16068
 
-
 
16069
{  utility draw  }
-
 
16070
 
-
 
16071
procedure DXDraw_Draw(DXDraw: TCustomDXDraw; Image: TPictureCollectionItem;
-
 
16072
  Rect: TRect; Pattern: Integer; TextureFilter: TD2DTextureFilter;
-
 
16073
  MirrorFlip: TRenderMirrorFlipSet;
-
 
16074
  BlendMode: TRenderType; Angle: Single; Alpha: Byte;
-
 
16075
  CenterX: Double; CenterY: Double;
-
 
16076
  Scale: Single); {$IFDEF VER9UP}inline;{$ENDIF}
-
 
16077
var
-
 
16078
//  r: TRect;
-
 
16079
  width, height: Integer;
-
 
16080
begin
-
 
16081
  if not Assigned(DXDraw.Surface) then Exit;
-
 
16082
  if not Assigned(Image) then Exit;
-
 
16083
  if Scale <> 1.0 then begin
-
 
16084
    width := Round(Scale * Image.Width);
-
 
16085
    height := Round(Scale * Image.Height);
-
 
16086
  end
-
 
16087
  else begin
-
 
16088
    width := Image.Width;
-
 
16089
    height := Image.Height;
-
 
16090
  end;
-
 
16091
  //r := Bounds(X, Y, width, height);
-
 
16092
  DXDraw.TextureFilter(TextureFilter);
-
 
16093
  DXDraw.MirrorFlip(MirrorFlip);
-
 
16094
  case BlendMode of
-
 
16095
    rtDraw: begin
-
 
16096
        if Angle = 0 then
-
 
16097
          Image.StretchDraw(DXDraw.Surface, Rect, Pattern)
-
 
16098
        else
-
 
16099
          Image.DrawRotate(DXDraw.Surface, (Rect.Left + Rect.Right) div 2,
-
 
16100
            (Rect.Top + Rect.Bottom) div 2,
-
 
16101
            Width, Height, Pattern, CenterX, CenterY, Angle);
-
 
16102
      end;
-
 
16103
    rtBlend: begin
-
 
16104
        if Angle = 0 then
-
 
16105
          Image.DrawAlpha(DXDraw.Surface, Rect, Pattern, Alpha)
-
 
16106
        else
-
 
16107
          Image.DrawRotateAlpha(DXDraw.Surface, (Rect.Left + Rect.Right) div 2,
-
 
16108
            (Rect.Top + Rect.Bottom) div 2,
-
 
16109
            Width, Height, Pattern, CenterX, CenterY, Angle, Alpha);
-
 
16110
      end;
-
 
16111
    rtAdd: begin
-
 
16112
        if Angle = 0 then
-
 
16113
          Image.DrawAdd(DXDraw.Surface, Rect, Pattern, Alpha)
-
 
16114
        else
-
 
16115
          Image.DrawRotateAdd(DXDraw.Surface, (Rect.Left + Rect.Right) div 2,
-
 
16116
            (Rect.Top + Rect.Bottom) div 2,
-
 
16117
            Width, Height, Pattern, CenterX, CenterY, Angle, Alpha);
-
 
16118
      end;
-
 
16119
    rtSub: begin
-
 
16120
        if Angle = 0 then
-
 
16121
          Image.DrawSub(DXDraw.Surface, Rect, Pattern, Alpha)
-
 
16122
        else
-
 
16123
          Image.DrawRotateSub(DXDraw.Surface, (Rect.Left + Rect.Right) div 2,
-
 
16124
            (Rect.Top + Rect.Bottom) div 2,
-
 
16125
            Width, Height, Pattern, CenterX, CenterY, Angle, Alpha);
-
 
16126
      end;
-
 
16127
  end; {case}
-
 
16128
end;
-
 
16129
 
-
 
16130
procedure DXDraw_Paint(DXDraw: TCustomDXDraw; Image: TPictureCollectionItem;
-
 
16131
  Rect: TRect; Pattern: Integer; var BlurImageArr: TBlurImageArr; BlurImage: Boolean;
-
 
16132
  TextureFilter: TD2DTextureFilter;
-
 
16133
  MirrorFlip: TRenderMirrorFlipSet;
-
 
16134
  BlendMode: TRenderType;
-
 
16135
  Angle: Single;
-
 
16136
  Alpha: Byte;
-
 
16137
  CenterX: Double; CenterY: Double); {$IFDEF VER9UP}inline;{$ENDIF}
-
 
16138
var
-
 
16139
  rr: TRect;
-
 
16140
  i, width, height: Integer;
-
 
16141
begin
-
 
16142
  if not Assigned(DXDraw.Surface) then Exit;
-
 
16143
  if not Assigned(Image) then Exit;
-
 
16144
  width := Image.Width;
-
 
16145
  height := Image.Height;
-
 
16146
  //rr := Bounds(X, Y, width, height);
-
 
16147
  //DXDraw.MirrorFlip(MirrorFlip);
-
 
16148
  DXDraw.TextureFilter(TextureFilter);
-
 
16149
  case BlendMode of
-
 
16150
    rtDraw: begin
-
 
16151
        if BlurImage then begin
-
 
16152
          for i := Low(BlurImageArr) to High(BlurImageArr) do if BlurImageArr[i].eActive then begin
-
 
16153
              DXDraw.MirrorFlip(MirrorFlip);
-
 
16154
              rr := Bounds(BlurImageArr[i].eX, BlurImageArr[i].eY, Width, Height);
-
 
16155
              if Angle = 0 then
-
 
16156
                Image.DrawAlpha(DXDraw.Surface, rr, BlurImageArr[i].ePatternIndex, BlurImageArr[i].eIntensity)
-
 
16157
              else
-
 
16158
                Image.DrawRotateAlpha(DXDraw.Surface, (rr.Left + rr.Right) div 2,
-
 
16159
                  (rr.Top + rr.Bottom) div 2,
-
 
16160
                  Width, Height, BlurImageArr[i].ePatternIndex, CenterX, CenterY, BlurImageArr[i].eAngle, BlurImageArr[i].eIntensity);
-
 
16161
              if BlurImageArr[i].eIntensity > 0 then Dec(BlurImageArr[i].eIntensity) else FillChar(BlurImageArr[i], SizeOf(BlurImageArr[i]), 0);
-
 
16162
            end;
-
 
16163
        end;
-
 
16164
        DXDraw.MirrorFlip(MirrorFlip);
-
 
16165
        if Angle = 0 then
-
 
16166
          Image.StretchDraw(DXDraw.Surface, Rect, Pattern)
-
 
16167
        else
-
 
16168
          Image.DrawRotate(DXDraw.Surface, (Rect.Left + Rect.Right) div 2,
-
 
16169
            (Rect.Top + Rect.Bottom) div 2,
-
 
16170
            Width, Height, Pattern, CenterX, CenterY, Angle);
-
 
16171
      end;
-
 
16172
    rtBlend: begin
-
 
16173
        if BlurImage then begin
-
 
16174
          for i := Low(BlurImageArr) to High(BlurImageArr) do if BlurImageArr[i].eActive then begin
-
 
16175
              DXDraw.MirrorFlip(MirrorFlip);
-
 
16176
              rr := Bounds(BlurImageArr[i].eX, BlurImageArr[i].eY, Width, Height);
-
 
16177
              if Angle = 0 then
-
 
16178
                Image.DrawAlpha(DXDraw.Surface, rr, Pattern, BlurImageArr[i].eIntensity)
-
 
16179
              else
-
 
16180
                Image.DrawRotateAlpha(DXDraw.Surface, (rr.Left + rr.Right) div 2,
-
 
16181
                  (rr.Top + rr.Bottom) div 2,
-
 
16182
                  Width, Height, Pattern, CenterX, CenterY, BlurImageArr[i].eAngle, BlurImageArr[i].eIntensity);
-
 
16183
              if BlurImageArr[i].eIntensity > 0 then Dec(BlurImageArr[i].eIntensity) else FillChar(BlurImageArr[i], SizeOf(BlurImageArr[i]), 0);
-
 
16184
            end;
-
 
16185
        end;
-
 
16186
        DXDraw.MirrorFlip(MirrorFlip);
-
 
16187
        if Angle = 0 then
-
 
16188
          Image.DrawAlpha(DXDraw.Surface, Rect, Pattern, Alpha)
-
 
16189
        else
-
 
16190
          Image.DrawRotateAlpha(DXDraw.Surface, (Rect.Left + Rect.Right) div 2,
-
 
16191
            (Rect.Top + Rect.Bottom) div 2,
-
 
16192
            Width, Height, Pattern, CenterX, CenterY, Angle, Alpha);
-
 
16193
      end;
-
 
16194
    rtAdd: begin
-
 
16195
        if BlurImage then begin
-
 
16196
          for i := Low(BlurImageArr) to High(BlurImageArr) do if BlurImageArr[i].eActive then begin
-
 
16197
              DXDraw.MirrorFlip(MirrorFlip);
-
 
16198
              rr := Bounds(BlurImageArr[i].eX, BlurImageArr[i].eY, Width, Height);
-
 
16199
              if Angle = 0 then
-
 
16200
                Image.DrawAdd(DXDraw.Surface, rr, Pattern, BlurImageArr[i].eIntensity)
-
 
16201
              else
-
 
16202
                Image.DrawRotateAdd(DXDraw.Surface, (rr.Left + rr.Right) div 2,
-
 
16203
                  (rr.Top + rr.Bottom) div 2,
-
 
16204
                  Width, Height, Pattern, CenterX, CenterY, BlurImageArr[i].eAngle, BlurImageArr[i].eIntensity);
-
 
16205
              if BlurImageArr[i].eIntensity > 0 then Dec(BlurImageArr[i].eIntensity) else FillChar(BlurImageArr[i], SizeOf(BlurImageArr[i]), 0);
-
 
16206
            end;
-
 
16207
        end;
-
 
16208
        DXDraw.MirrorFlip(MirrorFlip);
-
 
16209
        if Angle = 0 then
-
 
16210
          Image.DrawAdd(DXDraw.Surface, Rect, Pattern, Alpha)
-
 
16211
        else
-
 
16212
          Image.DrawRotateAdd(DXDraw.Surface, (Rect.Left + Rect.Right) div 2,
-
 
16213
            (Rect.Top + Rect.Bottom) div 2,
-
 
16214
            Width, Height, Pattern, CenterX, CenterY, Angle, Alpha);
-
 
16215
      end;
-
 
16216
    rtSub: begin
-
 
16217
        if BlurImage then begin
-
 
16218
          for i := Low(BlurImageArr) to High(BlurImageArr) do if BlurImageArr[i].eActive then begin
-
 
16219
              DXDraw.MirrorFlip(MirrorFlip);
-
 
16220
              rr := Bounds(BlurImageArr[i].eX, BlurImageArr[i].eY, Width, Height);
-
 
16221
              if Angle = 0 then
-
 
16222
                Image.DrawSub(DXDraw.Surface, rr, Pattern, BlurImageArr[i].eIntensity)
-
 
16223
              else
-
 
16224
                Image.DrawRotateSub(DXDraw.Surface, (rr.Left + rr.Right) div 2,
-
 
16225
                  (rr.Top + rr.Bottom) div 2,
-
 
16226
                  Width, Height, Pattern, CenterX, CenterY, BlurImageArr[i].eAngle, BlurImageArr[i].eIntensity);
-
 
16227
              if BlurImageArr[i].eIntensity > 0 then Dec(BlurImageArr[i].eIntensity) else FillChar(BlurImageArr[i], SizeOf(BlurImageArr[i]), 0);
-
 
16228
            end;
-
 
16229
        end;
-
 
16230
        DXDraw.MirrorFlip(MirrorFlip);
-
 
16231
        if Angle = 0 then
-
 
16232
          Image.DrawSub(DXDraw.Surface, Rect, Pattern, Alpha)
-
 
16233
        else
-
 
16234
          Image.DrawRotateSub(DXDraw.Surface, (Rect.Left + Rect.Right) div 2,
-
 
16235
            (Rect.Top + Rect.Bottom) div 2,
-
 
16236
            Width, Height, Pattern, CenterX, CenterY, Angle, Alpha);
-
 
16237
      end;
-
 
16238
  end; {case}
-
 
16239
end;
-
 
16240
 
-
 
16241
procedure DXDraw_Render(DXDraw: TCustomDXDraw; Image: TPictureCollectionItem;
-
 
16242
  Rect: TRect; Pattern: Integer; var BlurImageArr: TBlurImageArr; BlurImage: Boolean;
-
 
16243
  TextureFilter: TD2DTextureFilter; MirrorFlip: TRenderMirrorFlipSet;
-
 
16244
  BlendMode: TRenderType;
-
 
16245
  Angle: Single;
-
 
16246
  Alpha: Byte;
-
 
16247
  CenterX: Double; CenterY: Double;
-
 
16248
  Scale: Single;
-
 
16249
  WaveType: TWaveType;
-
 
16250
  Amplitude: Integer; AmpLength: Integer; Phase: Integer); {$IFDEF VER9UP}inline;{$ENDIF}
-
 
16251
var
-
 
16252
  rr: TRect;
-
 
16253
  i, width, height: Integer;
-
 
16254
begin
-
 
16255
  if not Assigned(DXDraw.Surface) then Exit;
-
 
16256
  if not Assigned(Image) then Exit;
-
 
16257
  if Scale <> 1.0 then begin
-
 
16258
    width := Round(Scale * Image.Width);
-
 
16259
    height := Round(Scale * Image.Height);
-
 
16260
  end
-
 
16261
  else begin
-
 
16262
    width := Image.Width;
-
 
16263
    height := Image.Height;
-
 
16264
  end;
-
 
16265
  //r := Bounds(X, Y, width, height);
-
 
16266
  DXDraw.TextureFilter(TextureFilter);
-
 
16267
  DXDraw.MirrorFlip(MirrorFlip);
-
 
16268
  case BlendMode of
-
 
16269
    rtDraw:
-
 
16270
      begin
-
 
16271
        case WaveType of
-
 
16272
          wtWaveNone:
-
 
16273
            begin
-
 
16274
              if BlurImage then begin
-
 
16275
                for i := Low(BlurImageArr) to High(BlurImageArr) do if BlurImageArr[i].eActive then begin
-
 
16276
                    DXDraw.MirrorFlip(MirrorFlip);
-
 
16277
                    rr := Bounds(BlurImageArr[i].eX, BlurImageArr[i].eY, Round(Scale * Width), Round(Scale * Height));
-
 
16278
                    if Angle = 0 then
-
 
16279
                      Image.DrawAlpha(DXDraw.Surface, rr, BlurImageArr[i].ePatternIndex, BlurImageArr[i].eIntensity)
-
 
16280
                    else
-
 
16281
                      Image.DrawRotateAlpha(DXDraw.Surface, (rr.Left + rr.Right) div 2,
-
 
16282
                        (rr.Top + rr.Bottom) div 2,
-
 
16283
                        Width, Height, BlurImageArr[i].ePatternIndex, CenterX, CenterY, BlurImageArr[i].eAngle, BlurImageArr[i].eIntensity);
-
 
16284
                    if BlurImageArr[i].eIntensity > 0 then Dec(BlurImageArr[i].eIntensity) else FillChar(BlurImageArr[i], SizeOf(BlurImageArr[i]), 0);
-
 
16285
                  end;
-
 
16286
              end;
-
 
16287
              DXDraw.MirrorFlip(MirrorFlip);
-
 
16288
              if Angle = 0 then
-
 
16289
                Image.StretchDraw(DXDraw.Surface, Rect, Pattern)
-
 
16290
              else
-
 
16291
                Image.DrawRotate(DXDraw.Surface, (Rect.Left + Rect.Right) div 2,
-
 
16292
                  (Rect.Top + Rect.Bottom) div 2,
-
 
16293
                  Width, Height, Pattern, CenterX, CenterY, Angle);
-
 
16294
            end;
-
 
16295
          wtWaveX: Image.DrawWaveX(DXDraw.Surface, Round(Rect.Left), Round(Rect.Top), Width, Height, Pattern, Amplitude, AmpLength, Phase);
-
 
16296
          wtWaveY: Image.DrawWaveY(DXDraw.Surface, Round(Rect.Left), Round(Rect.Top), Width, Height, Pattern, Amplitude, AmpLength, Phase);
-
 
16297
        end;
-
 
16298
      end;
-
 
16299
    rtBlend: begin
-
 
16300
        case WaveType of
-
 
16301
          wtWaveNone: begin
-
 
16302
              if BlurImage then begin
-
 
16303
                for i := Low(BlurImageArr) to High(BlurImageArr) do if BlurImageArr[i].eActive then begin
-
 
16304
                    DXDraw.MirrorFlip(MirrorFlip);
-
 
16305
                    rr := Bounds(BlurImageArr[i].eX, BlurImageArr[i].eY, Round(Scale * Width), Round(Scale * Height));
-
 
16306
                    if Angle = 0 then
-
 
16307
                      Image.DrawAlpha(DXDraw.Surface, rr, Pattern, BlurImageArr[i].eIntensity)
-
 
16308
                    else
-
 
16309
                      Image.DrawRotateAlpha(DXDraw.Surface, (rr.Left + rr.Right) div 2,
-
 
16310
                        (rr.Top + rr.Bottom) div 2,
-
 
16311
                        Width, Height, Pattern, CenterX, CenterY, BlurImageArr[i].eAngle, BlurImageArr[i].eIntensity);
-
 
16312
                    if BlurImageArr[i].eIntensity > 0 then Dec(BlurImageArr[i].eIntensity) else FillChar(BlurImageArr[i], SizeOf(BlurImageArr[i]), 0);
-
 
16313
                  end;
-
 
16314
              end;
-
 
16315
              DXDraw.MirrorFlip(MirrorFlip);
-
 
16316
              if Angle = 0 then
-
 
16317
                Image.DrawAlpha(DXDraw.Surface, Rect, Pattern, Alpha)
-
 
16318
              else
-
 
16319
                Image.DrawRotateAlpha(DXDraw.Surface, (Rect.Left + Rect.Right) div 2,
-
 
16320
                  (Rect.Top + Rect.Bottom) div 2,
-
 
16321
                  Width, Height, Pattern, CenterX, CenterY, Angle, Alpha);
-
 
16322
            end;
-
 
16323
          wtWaveX: Image.DrawWaveXAlpha(DXDraw.Surface, Round(Rect.Left), Round(Rect.Top), Width, Height, Pattern, Amplitude, AmpLength, Phase, Alpha);
-
 
16324
          wtWaveY: Image.DrawWaveYAlpha(DXDraw.Surface, Round(Rect.Top), Round(Rect.Top), Width, Height, Pattern, Amplitude, AmpLength, Phase, Alpha);
-
 
16325
        end;
-
 
16326
      end;
-
 
16327
    rtAdd: begin
-
 
16328
        case WaveType of
-
 
16329
          wtWaveNone: begin
-
 
16330
              if BlurImage then begin
-
 
16331
                for i := Low(BlurImageArr) to High(BlurImageArr) do if BlurImageArr[i].eActive then begin
-
 
16332
                    DXDraw.MirrorFlip(MirrorFlip);
-
 
16333
                    rr := Bounds(BlurImageArr[i].eX, BlurImageArr[i].eY, Round(Scale * Width), Round(Scale * Height));
-
 
16334
                    if Angle = 0 then
-
 
16335
                      Image.DrawAdd(DXDraw.Surface, rr, Pattern, BlurImageArr[i].eIntensity)
-
 
16336
                    else
-
 
16337
                      Image.DrawRotateAdd(DXDraw.Surface, (rr.Left + rr.Right) div 2,
-
 
16338
                        (rr.Top + rr.Bottom) div 2,
-
 
16339
                        Width, Height, Pattern, CenterX, CenterY, BlurImageArr[i].eAngle, BlurImageArr[i].eIntensity);
-
 
16340
                    if BlurImageArr[i].eIntensity > 0 then Dec(BlurImageArr[i].eIntensity) else FillChar(BlurImageArr[i], SizeOf(BlurImageArr[i]), 0);
-
 
16341
                  end;
-
 
16342
              end;
-
 
16343
              DXDraw.MirrorFlip(MirrorFlip);
-
 
16344
              if Angle = 0 then
-
 
16345
                Image.DrawAdd(DXDraw.Surface, Rect, Pattern, Alpha)
-
 
16346
              else
-
 
16347
                Image.DrawRotateAdd(DXDraw.Surface, (Rect.Left + Rect.Right) div 2,
-
 
16348
                  (Rect.Top + Rect.Bottom) div 2,
-
 
16349
                  Width, Height, Pattern, CenterX, CenterY, Angle, Alpha);
-
 
16350
            end;
-
 
16351
          wtWaveX: Image.DrawWaveXAdd(DXDraw.Surface, Round(Rect.Left), Round(Rect.Top), Width, Height, Pattern, Amplitude, AmpLength, Phase, Alpha);
-
 
16352
          wtWaveY: Image.DrawWaveYAdd(DXDraw.Surface, Round(Rect.Top), Round(Rect.Top), Width, Height, Pattern, Amplitude, AmpLength, Phase, Alpha);
-
 
16353
        end;
-
 
16354
      end;
-
 
16355
    rtSub: begin
-
 
16356
        case WaveType of
-
 
16357
          wtWaveNone: begin
-
 
16358
              if BlurImage then begin
-
 
16359
                for i := Low(BlurImageArr) to High(BlurImageArr) do if BlurImageArr[i].eActive then begin
-
 
16360
                    DXDraw.MirrorFlip(MirrorFlip);
-
 
16361
                    rr := Bounds(BlurImageArr[i].eX, BlurImageArr[i].eY, Round(Scale * Width), Round(Scale * Height));
-
 
16362
                    if Angle = 0 then
-
 
16363
                      Image.DrawSub(DXDraw.Surface, rr, Pattern, BlurImageArr[i].eIntensity)
-
 
16364
                    else
-
 
16365
                      Image.DrawRotateSub(DXDraw.Surface, (rr.Left + rr.Right) div 2,
-
 
16366
                        (rr.Top + rr.Bottom) div 2,
-
 
16367
                        Width, Height, Pattern, CenterX, CenterY, BlurImageArr[i].eAngle, BlurImageArr[i].eIntensity);
-
 
16368
                    if BlurImageArr[i].eIntensity > 0 then Dec(BlurImageArr[i].eIntensity) else FillChar(BlurImageArr[i], SizeOf(BlurImageArr[i]), 0);
-
 
16369
                  end;
-
 
16370
              end;
-
 
16371
              DXDraw.MirrorFlip(MirrorFlip);
-
 
16372
              if Angle = 0 then
-
 
16373
                Image.DrawSub(DXDraw.Surface, Rect, Pattern, Alpha)
-
 
16374
              else
-
 
16375
                Image.DrawRotateSub(DXDraw.Surface, (Rect.Left + Rect.Right) div 2,
-
 
16376
                  (Rect.Top + Rect.Bottom) div 2,
-
 
16377
                  Width, Height, Pattern, CenterX, CenterY, Angle, Alpha);
-
 
16378
            end;
-
 
16379
          wtWaveX: Image.DrawWaveXSub(DXDraw.Surface, Round(Rect.Left), Round(Rect.Top), Width, Height, Pattern, Amplitude, AmpLength, Phase, Alpha);
-
 
16380
          wtWaveY: Image.DrawWaveYSub(DXDraw.Surface, Round(Rect.Top), Round(Rect.Top), Width, Height, Pattern, Amplitude, AmpLength, Phase, Alpha);
-
 
16381
        end;
-
 
16382
      end;
-
 
16383
  end; {case}
-
 
16384
end;
-
 
16385
 
7070
initialization
16386
initialization
-
 
16387
  _DXTextureImageLoadFuncList := TList.Create;
-
 
16388
  TDXTextureImage.RegisterLoadFunc(DXTextureImage_LoadDXTextureImageFunc); //delete Mr.Kawasaki
-
 
16389
  TDXTextureImage.RegisterLoadFunc(DXTextureImage_LoadBitmapFunc);
7071
finalization
16390
finalization
-
 
16391
  TDXTextureImage.UnRegisterLoadFunc(DXTextureImage_LoadDXTextureImageFunc); //delete Mr.Kawasaki
-
 
16392
  TDXTextureImage.UnRegisterLoadFunc(DXTextureImage_LoadBitmapFunc);
-
 
16393
  _DXTextureImageLoadFuncList.Free;
-
 
16394
  { driver free }
7072
  DirectDrawDrivers.Free;
16395
  DirectDrawDrivers.Free;
-
 
16396
  {$IFDEF _DMO_}DirectDrawDriversEx.Free;{$ENDIF}
7073
end.
16397
end.
7074
 
-
 
7075
 
-
 
7076
 
16398