_D3DFORMAT and object inspector???

[TheLion]

I sometimes help out a friend who is writing a component set for use with DirectX, however with his lastig question he got me puzzled and I was hoping you guys could help me out...

He wants to make a property that is shown as combobox, with all the constants as items in the object inspector, which is pretty easy:

Type TSomething = (option1, option2, option3);
property Something : TSomething write FSomething read FSomething;

This is not the problem, but he wants to do this with the _D3DFormat type which can be found in the Direct3D8 library. When this type is used in a property it just plainly shows an "editbox" for integer values, here is the structure of the _D3DFormat type (shortened):

type
_D3DFORMAT = {$IFDEF TYPE_IDENTITY}type {$ENDIF}DWord;
{$ELSE}
type
_D3DFORMAT = (
D3DFMT_UNKNOWN = 0,

D3DFMT_R8G8B8 = 20,
D3DFMT_A8R8G8B8 = 21,
D3DFMT_X8R8G8B8 = 22,
D3DFMT_R5G6B5 = 23,
D3DFMT_INDEX32 =102,
...
D3DFMT_FORCE_DWORD = $7fffffff
);

{$ENDIF}
{$EXTERNALSYM _D3DFORMAT}
D3DFORMAT = _D3DFORMAT;
{$EXTERNALSYM D3DFORMAT}
PD3DFormat = ^TD3DFormat;
TD3DFormat = _D3DFORMAT;

How can I make the constant values appear in the object inspector in some sort of combobox... I looked up the TColor property and type and tried to make a copy of the _D3DFormat structure/type and edit it so it would work like the TColor type, but it did exactly the same as it does now, it shows an editbox for integral input!

[Alimonster]

Hmm, that's strange! Try the following code. You should see a combobox for the 'Something' property:

[pascal]unit anothercomponent;

interface

uses
Classes;

type
TMyType = (mtA, mtB, mtC);

TAnotherComponent = class(TComponent)
private
FSomething: TMyType;
published
property Something: TMyType read FSomething write FSomething;
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('Samples', [TAnotherComponent]);
end;

end.[/pascal]

You'll have to confirm what part of the unit is being compiled first! I noticed that there's a {$ELSE} sitting there in the code snippet you gave. These mean to conditionally compile - which means one of the branches won't compile at all! If you're unlucky, your type will be

[pascal]type
_D3DFORMAT = {$IFDEF TYPE_IDENTITY}type {$ENDIF}DWord;[/pascal]

That won't have a combobox because it's simply a number! (DWord = 32 bit unsigned integer, aka LongWord or Cardinal [in its current size]). How would Delphi possibly know what values to drop down if that's the case? (Note that the extra 'type' part there simply gives the new type a unique identity, so that you can't directly assign a DWord to a _D3DFormat type without a cast.

If that bit *is* the one being compiled, you'll have to write your own property editor I guess. You could create a form or dialogue with the known possible values (maybe a combobox) and an OK button. For more info, here are three articles by Peter Morris

http://www.howtodothings.com/showart...sp?article=310
http://www.howtodothings.com/showart...sp?article=320
http://www.howtodothings.com/showart...sp?article=327

[TheLion]

Okay, but the strange thing is, when I use something like this:

Type TSomething = (option1 = 10, option2 = 20, option3 = 40);

I get an error... I use Delphi 5 Enterprise Edt. and I have no clue how to solve this problem... Your method works fine, but doesn't add any values to the combobox items...

The problem is that the value returned by the property should be a DWORD value and probably one of the constants, however I could make such a list by using a case statement in the SetProperty(Value : TSomething) and setting the DWord value after walking true a case statement, but it would take away the possibility of assigning a DWORD value that is not in the TSomething list, while with the TColor type you can add everything within a certain range... I need something like TColor, but a copy of the TColor structure and type declaration and then renaming TColor for something else and using it, gives exactly the same result, just a editbox for integral values... :?

I'll take a look at the articles you game me!

[Useless Hacker]

Okay, but the strange thing is, when I use something like this:

Type TSomething = (option1 = 10, option2 = 20, option3 = 40);

I get an error... I use Delphi 5 Enterprise Edt. and I have no clue how to solve this problem... Your method works fine, but doesn't add any values to the combobox items...

I think you can only give enums explicit values in Delphi6+.

[TheLion]

Could be, however the TColor value is doing it...
I found something called TEnumProperty and I'm going to look into that, it might solve the problem!

[Clootie]

From mine [private] component set:
[pascal]unit XRunnerDesign;

interface

{$Include JEDI.inc}

uses
Classes, SysUtils, TypInfo,
{$IFNDEF VER140}
DsgnIntf,
{$ELSE}
DesignEditors, DesignIntf,
{$ENDIF}
Direct3D8, XRunnerCore, XRunnerDisplay, XRTimer;

type
{ TDirectDrawDisplayProperty }
TXRunnerD3DFormat = class(TStringProperty)
public
function GetAttributes: TPropertyAttributes; override;
procedure GetValues(Proc: TGetStrProc); override;
end;

TXRunnerBackFormat = class(TXRunnerD3DFormat)
public
procedure GetValues(Proc: TGetStrProc); override;
end;

TXRunnerDepthFormat = class(TXRunnerD3DFormat)
public
procedure GetValues(Proc: TGetStrProc); override;
end;

procedure Register;

implementation

procedure Register;
begin
RegisterPropertyEditor(TypeInfo(String), TXRunnerDisplay, 'BackFormatStr', TXRunnerBackFormat);
RegisterPropertyEditor(TypeInfo(String), TXRunnerDisplay, 'DepthFormatStr', TXRunnerDepthFormat);

RegisterComponents('Visual', [TXRunnerDispatcher, TXRunner, TXROutputWindow, TXRunnerTimer]);
end;

{ TXRunnerD3DFormat }

function TXRunnerD3DFormat.GetAttributes: TPropertyAttributes;
begin
Result:= [paValueList, paMultiSelect, paRevertable];
end;

procedure TXRunnerD3DFormat.GetValues(Proc: TGetStrProc);
var
i: Integer;
begin
for i:= 0 to High(KnownFormats) do Proc(KnownFormats[i].N);
end;

{ TXRunnerBackFormat }

procedure TXRunnerBackFormat.GetValues(Proc: TGetStrProc);
begin
Proc('R8G8B8');
Proc('A8R8G8B8');
Proc('X8R8G8B8');
Proc('R5G6B5');
Proc('X1R5G5B5');
Proc('A1R5G5B5');
Proc('A4R4G4B4');
Proc('R3G3B2');
Proc('A8R3G3B2');
Proc('X4R4G4B4');
end;

{ TXRunnerDepthFormat }

procedure TXRunnerDepthFormat.GetValues(Proc: TGetStrProc);
var
i: Integer;
begin
for i:= 30 to 36 do Proc(KnownFormats[i].N);
end;

end.
[/code]

Forgot to add:
[code]unit XRunnerDisplay;

interface

{$Include JEDI.inc}

uses
Classes, SysUtils, Windows, MultiMon, Direct3D8;

type
....

{ TXRunnerDisplay }
TXRunnerDisplay = class(TPersistent)
private
...
FBackFormat: TD3DFormat;
FDepthFormat: TD3DFormat;
...
public
constructor Create; virtual;
property BackFormat: TD3DFormat read FBackFormat write SetBackFormat;
property DepthFormat: TD3DFormat read FDepthFormat write SetDepthFormat;
published
...
// Delphi6 RTTI & streaming hack
property BackFormatStr: String read GetBackFormat write SetBackFormatS;
property DepthFormatStr: String read GetDepthFormat write SetDepthFormatS;
...
end;

type
TFormatRec = record
N: PChar; // Name
F: TD3DFormat; // Format
end;

const
KnownFormats: array [0..39] of TFormatRec = (
(N:'UNKNOWN'; F3DFMT_UNKNOWN),

(N:'R8G8B8'; F3DFMT_R8G8B,
(N:'A8R8G8B8'; F3DFMT_A8R8G8B,
(N:'X8R8G8B8'; F3DFMT_X8R8G8B,
(N:'R5G6B5'; F3DFMT_R5G6B5),
(N:'X1R5G5B5'; F3DFMT_X1R5G5B5),
(N:'A1R5G5B5'; F3DFMT_A1R5G5B5),
(N:'A4R4G4B4'; F3DFMT_A4R4G4B4),
(N:'R3G3B2'; F3DFMT_R3G3B2),
(N:'A8'; F3DFMT_A,
(N:'A8R3G3B2'; F3DFMT_A8R3G3B2),
(N:'X4R4G4B4'; F3DFMT_X4R4G4B4),

(N:'A8P8'; F3DFMT_A8P,
(N:'P8'; F3DFMT_P,

(N:'L8'; F3DFMT_L,
(N:'A8L8'; F3DFMT_A8L,
(N:'A4L4'; F3DFMT_A4L4),

(N:'V8U8'; F3DFMT_V8U,
(N:'L6V5U5'; F3DFMT_L6V5U5),
(N:'X8L8V8U8'; F3DFMT_X8L8V8U,
(N:'Q8W8V8U8'; F3DFMT_Q8W8V8U,
(N:'V16U16'; F3DFMT_V16U16),
(N:'W11V11U10'; F3DFMT_W11V11U10),

(N:'UYVY'; F3DFMT_UYVY),
(N:'YUY2'; F3DFMT_YUY2),
(N:'DXT1'; F3DFMT_DXT1),
(N:'DXT2'; F3DFMT_DXT2),
(N:'DXT3'; F3DFMT_DXT3),
(N:'DXT4'; F3DFMT_DXT4),
(N:'DXT5'; F3DFMT_DXT5),

(N:'D16_LOCKABLE';F3DFMT_D16_LOCKABLE), // 30
(N:'D32'; F3DFMT_D32),
(N:'D15S1'; F3DFMT_D15S1),
(N:'D24S8'; F3DFMT_D24S,
(N:'D16'; F3DFMT_D16),
(N:'D24X8'; F3DFMT_D24X,
(N:'D24X4S4'; F3DFMT_D24X4S4),

(N:'VERTEXDATA';F3DFMT_VERTEXDATA), // 37
(N:'INDEX16'; F3DFMT_INDEX16),
(N:'INDEX32'; F3DFMT_INDEX32)
);

function D3DFormatToString(Format: TD3DFormat): String;
function StringToD3DFormat(Str: String): TD3DFormat;

implementation

uses Math;

....

function TXRunnerDisplay.GetBackFormat: String;
begin
Result:= D3DFormatToString(FBackFormat);
end;

function TXRunnerDisplay.GetDepthFormat: String;
begin
Result:= D3DFormatToString(FDepthFormat);
end;


function D3DFormatToString(Format: TD3DFormat): String;
var
i: Integer;
begin
for i:= 0 to High(KnownFormats) do
if KnownFormats[i].F = Format then
begin
Result:= KnownFormats[i].N;
Exit;
end;
{$IFDEF COMPILER6_UP}
Result:= IntToStr(Integer(Format));
{$ELSE}
Result:= IntToStr(Format);
{$ENDIF}
end;

function StringToD3DFormat(Str: String): TD3DFormat;
var
i: Integer;
begin
Result:= D3DFMT_UNKNOWN;
Str:= UpperCase(Str);
for i:= 0 to High(KnownFormats) do
if KnownFormats[i].N = Str then
begin
Result:= KnownFormats[i].F;
Exit;
end;
end;

end.
[/pascal]
So for Delphi6 and up for enums with explicit valued (these can not be published) you have to add ghost properties:
[pascal] // Delphi6 RTTI & streaming hack
property BackFormatStr: String read GetBackFormat write SetBackFormatS;
property DepthFormatStr: String read GetDepthFormat write SetDepthFormatS;[/pascal]

[Clootie]

Just checked more natural way of handling enums with explicit values (still based on ghost properties):
[pascal]unit Unit1_test;

interface

uses
Classes, Controls, StdCtrls, DesignEditors, DesignIntf;

type
TEnum1 = (xxx, yyy, zzz, rrr=5);

TTestComponent = class(TButton)
private
FEnumProp: TEnum1;
procedure SetEnumProp(const Value: TEnum1);
function GetGhost: Cardinal;
procedure SetGhost(const Value: Cardinal);
/////
property aaa_EnumProp: TEnum1 read FEnumProp write SetEnumProp;
published
property aaa_Ghost: Cardinal read GetGhost write SetGhost;
end;

TTestProperty = class(TEnumProperty)
public
function GetAttributes: TPropertyAttributes; override;
function GetValue: string; override;
procedure GetValues(Proc: TGetStrProc); override;
procedure SetValue(const Value: string); override;
end;

procedure Register;

implementation

procedure Register;
begin
RegisterPropertyEditor(TypeInfo(Cardinal), TTestComponent, 'aaa_Ghost', TTestProperty);
RegisterComponents('Visual', [TTestComponent]);
end;


function TTestComponent.GetGhost: Cardinal;
begin
Result:= Cardinal(FEnumProp);
end;

procedure TTestComponent.SetGhost(const Value: Cardinal);
begin
FEnumProp:= TEnum1(value);
end;

procedure TTestComponent.SetEnumProp(const Value: TEnum1);
begin
FEnumProp := Value;
end;

{ TTestProperty }

function TTestProperty.GetAttributes: TPropertyAttributes;
begin
Result := [paMultiSelect, paValueList, paRevertable];
end;

function TTestProperty.GetValue: string;
begin
case GetOrdValue of
0: Result := 'Value1';
1: Result := 'Value2';
2: Result := 'Value3';
end;
end;

procedure TTestProperty.GetValues(Proc: TGetStrProc);
begin
Proc('Value1');
Proc('Value2');
Proc('Value3');
end;

procedure TTestProperty.SetValue(const Value: string);
begin
if Length(Value) < 6 then SetOrdValue(0)
else
case Value[6] of
'1': SetOrdValue(0);
'2': SetOrdValue(1);
'3': SetOrdValue(2);
end;
end;

end.[/pascal]

[Edit by BlueCat - Please use the new [ pascal ] tags instead of [ code ], thankyou ]