WebSVN – spacemission – Blame – /VCL_DELPHIX_D6/DXReg_original.pas

Rev	Author	Line No.	Line
1	daniel-mar	1	unit DXReg_original;
		2
		3	interface
		4
		5	uses
		6	Windows, SysUtils, Classes, DsgnIntf, Forms, Dialogs, Graphics, TypInfo,
		7	DXDraws, DXSounds, DIB, Wave, DXInput, DXPlay, DXSprite, DXClass;
		8
		9	type
		10
		11	{ TDXDrawDisplayProperty }
		12
		13	TDXDrawDisplayProperty = class(TClassProperty)
		14	public
		15	function GetAttributes: TPropertyAttributes; override;
		16	function GetValue: string; override;
		17	procedure GetValues(Proc: TGetStrProc); override;
		18	procedure SetValue(const Value: string); override;
		19	end;
		20
		21	{ TDIBProperty }
		22
		23	TDIBProperty = class(TPropertyEditor)
		24	public
		25	procedure Edit; override;
		26	function GetValue: string; override;
		27	function GetAttributes: TPropertyAttributes; override;
		28	end;
		29
		30	{ TDXDIBEditor }
		31
		32	TDXDIBEditor = class(TComponentEditor)
		33	public
		34	procedure Edit; override;
		35	procedure ExecuteVerb(Index: Integer); override;
		36	function GetVerb(Index: Integer): string; override;
		37	function GetVerbCount: Integer; override;
		38	end;
		39
		40	{ TPictureCollectionItem_PictureProperty }
		41
		42	TPictureCollectionItem_PictureProperty = class(TPropertyEditor)
		43	public
		44	procedure Edit; override;
		45	function GetValue: string; override;
		46	function GetAttributes: TPropertyAttributes; override;
		47	end;
		48
		49	{ TDXImageListEditor }
		50
		51	TDXImageListEditor = class(TComponentEditor)
		52	public
		53	procedure ExecuteVerb(Index: Integer); override;
		54	function GetVerb(Index: Integer): string; override;
		55	function GetVerbCount: Integer; override;
		56	end;
		57
		58	{ TWaveProperty }
		59
		60	TWaveProperty = class(TPropertyEditor)
		61	public
		62	procedure Edit; override;
		63	function GetValue: string; override;
		64	function GetAttributes: TPropertyAttributes; override;
		65	end;
		66
		67	{ TDXWaveEditor }
		68
		69	TDXWaveEditor = class(TComponentEditor)
		70	public
		71	procedure Edit; override;
		72	procedure ExecuteVerb(Index: Integer); override;
		73	function GetVerb(Index: Integer): string; override;
		74	function GetVerbCount: Integer; override;
		75	end;
		76
		77	{ TDXWaveListEditor }
		78
		79	TDXWaveListEditor = class(TComponentEditor)
		80	public
		81	procedure ExecuteVerb(Index: Integer); override;
		82	function GetVerb(Index: Integer): string; override;
		83	function GetVerbCount: Integer; override;
		84	end;
		85
		86	{ TForceFeedbackEffectsProperty }
		87
		88	TForceFeedbackEffectsProperty = class(TClassProperty)
		89	public
		90	procedure Edit; override;
		91	function GetValue: string; override;
		92	function GetAttributes: TPropertyAttributes; override;
		93	end;
		94
		95	{ TDXInputEditor }
		96
		97	TDXInputEditor = class(TComponentEditor)
		98	public
		99	procedure Edit; override;
		100	procedure ExecuteVerb(Index: Integer); override;
		101	function GetVerb(Index: Integer): string; override;
		102	function GetVerbCount: Integer; override;
		103	end;
		104
		105	{ TGUIDProperty }
		106
		107	TGUIDProperty = class(TStringProperty)
		108	public
		109	procedure Edit; override;
		110	function GetAttributes: TPropertyAttributes; override;
		111	end;
		112
		113	procedure Register;
		114
		115	implementation
		116
		117	uses DXPictEdit, DXWaveEdit, DXFFBEdit, DXInptEdit, DXGUIDEdit;
		118
		119	const
		120	SNone = '(None)';
		121
		122	SSettingImage = '&Image...';
		123	SSettingWave = '&Wave...';
		124	SDXGFileFilter = 'DXG file(.dxg)\|.dxg\|All files(.)\|.';
		125	SDXGOpenFileFilter = 'DXG file(.dxg)\|.dxg\|Bitmap file(.bmp)\|.bmp\|All files(.)\|.';
		126	SDXWFileFilter = 'DXW file(.dxw)\|.dxg\|All files(.)\|.';
		127	SDXWOpenFileFilter = 'DXW file(.dxw)\|.dxw\|Wave file(.wav)\|.wav\|All files(.)\|.';
		128	SSinglePlayer = '&Single player';
		129	SMultiPlayer1 = 'Multi player &1';
		130	SMultiPlayer2 = 'Multi player &2';
		131
		132	SOpen = '&Open...';
		133	SSave = '&Save..';
		134
		135	procedure Register;
		136	begin
		137	RegisterPropertyEditor(TypeInfo(TDXDrawDisplay), nil, '',
		138	TDXDrawDisplayProperty);
		139
		140	RegisterPropertyEditor(TypeInfo(TDIB), nil, '', TDIBProperty);
		141	RegisterComponentEditor(TCustomDXDIB, TDXDIBEditor);
		142
		143	RegisterPropertyEditor(TypeInfo(TPicture), TPictureCollectionItem, 'Picture', TPictureCollectionItem_PictureProperty);
		144	RegisterComponentEditor(TCustomDXImageList, TDXImageListEditor);
		145
		146	RegisterPropertyEditor(TypeInfo(TWave), nil, '', TWaveProperty);
		147	RegisterComponentEditor(TCustomDXWave, TDXWaveEditor);
		148
		149	RegisterComponentEditor(TCustomDXWaveList, TDXWaveListEditor);
		150
		151	RegisterPropertyEditor(TypeInfo(TForceFeedbackEffects), nil, '', TForceFeedbackEffectsProperty);
		152
		153	RegisterComponentEditor(TCustomDXInput, TDXInputEditor);
		154
		155	RegisterPropertyEditor(TypeInfo(string), TCustomDXPlay, 'GUID', TGUIDProperty);
		156
		157	RegisterComponents('DelphiX',
		158	[TDXDraw,
		159	TDXDIB,
		160	TDXImageList,
		161	TDX3D,
		162	TDXSound,
		163	TDXWave,
		164	TDXWaveList,
		165	TDXInput,
		166	TDXPlay,
		167	TDXSpriteEngine,
		168	TDXTimer,
		169	TDXPaintBox]);
		170	end;
		171
		172	{ TDXDrawDisplayProperty }
		173
		174	function TDXDrawDisplayProperty.GetAttributes: TPropertyAttributes;
		175	begin
		176	Result := inherited GetAttributes + [paValueList] - [paReadOnly];
		177	end;
		178
		179	const
		180	SDisplayMode = '%dx%dx%d';
		181
		182	function TDXDrawDisplayProperty.GetValue: string;
		183	begin
		184	with TDXDrawDisplay(GetOrdValue) do
		185	Result := Format(SDisplayMode, [Width, Height, BitCount]);
		186	end;
		187
		188	procedure TDXDrawDisplayProperty.GetValues(Proc: TGetStrProc);
		189	const
		190	List: array[0..2] of TPoint = (
		191	(X: 640; Y: 480),
		192	(X: 800; Y: 600),
		193	(X: 1024; Y: 768));
		194	var
		195	BitCount, i: Integer;
		196	begin
		197	for i:=Low(List) to High(List) do
		198	for BitCount:=1 to 3 do
		199	Proc(Format(SDisplayMode, [List[i].x, List[i].y, BitCount*8]));
		200	end;
		201
		202	procedure TDXDrawDisplayProperty.SetValue(const Value: string);
		203	var
		204	s: string;
		205	i, AWidth, AHeight, ABitCount: Integer;
		206	begin
		207	s := Value;
		208
		209	i := Pos('x', s);
		210	AWidth := StrToInt(Copy(s, 1, i-1));
		211	s := Copy(s, i+1, Length(s));
		212
		213	i := Pos('x', s);
		214	AHeight := StrToInt(Copy(s, 1, i-1));
		215	s := Copy(s, i+1, Length(s));
		216
		217	ABitCount := StrToInt(s);
		218
		219	with TDXDrawDisplay(GetOrdValue) do
		220	begin
		221	Width := AWidth;
		222	Height := AHeight;
		223	BitCount := ABitCount;
		224	end;
		225
		226	SetOrdValue(GetOrdValue);
		227	end;
		228
		229	{ TDIBProperty }
		230
		231	procedure TDIBProperty.Edit;
		232	var
		233	Form: TDelphiXPictureEditForm;
		234	begin
		235	Form := TDelphiXPictureEditForm.Create(nil);
		236	try
		237	Form.ViewBox.Picture.Assign(TDIB(GetOrdValue));
		238	Form.DIBClassOnly := True;
		239	Form.ShowModal;
		240	if Form.Tag<>0 then
		241	begin
		242	SetOrdValue(Integer(Form.ViewBox.Picture.Graphic));
		243	Designer.Modified;
		244	end;
		245	finally
		246	Form.Free;
		247	end;
		248	end;
		249
		250	function TDIBProperty.GetAttributes: TPropertyAttributes;
		251	begin
		252	Result := [paDialog, paReadOnly];
		253	end;
		254
		255	function TDIBProperty.GetValue: string;
		256	begin
		257	if TDIB(GetOrdValue).Size=0 then
		258	Result := SNone
		259	else
		260	Result := Format('(%s)', [TObject(GetOrdValue).ClassName]);
		261	end;
		262
		263	{ TDXDIBEditor }
		264
		265	procedure TDXDIBEditor.Edit;
		266	var
		267	Form: TDelphiXPictureEditForm;
		268	begin
		269	Form := TDelphiXPictureEditForm.Create(nil);
		270	try
		271	Form.ViewBox.Picture.Assign(TCustomDXDIB(Component).DIB);
		272	Form.DIBClassOnly := True;
		273	Form.ShowModal;
		274	if Form.Tag<>0 then
		275	begin
		276	TCustomDXDIB(Component).DIB.Assign(TGraphic(Form.ViewBox.Picture.Graphic));
		277	Designer.Modified;
		278	end;
		279	finally
		280	Form.Free;
		281	end;
		282	end;
		283
		284	procedure TDXDIBEditor.ExecuteVerb(Index: Integer);
		285	begin
		286	case Index of
		287	0: Edit;
		288	end;
		289	end;
		290
		291	function TDXDIBEditor.GetVerb(Index: Integer): string;
		292	begin
		293	case Index of
		294	0: Result := SSettingImage;
		295	end;
		296	end;
		297
		298	function TDXDIBEditor.GetVerbCount: Integer;
		299	begin
		300	Result := 1;
		301	end;
		302
		303	{ TPictureCollectionItem_PictureProperty }
		304
		305	procedure TPictureCollectionItem_PictureProperty.Edit;
		306	var
		307	Form: TDelphiXPictureEditForm;
		308	Item: TPictureCollectionItem;
		309	TempDIB: TDIB;
		310	begin
		311	Form := TDelphiXPictureEditForm.Create(nil);
		312	try
		313	Form.ViewBox.Picture := TPicture(GetOrdValue);
		314	Form.ShowModal;
		315	if Form.Tag<>0 then
		316	begin
		317	SetOrdValue(Integer(Form.ViewBox.Picture));
		318
		319	Item := GetComponent(0) as TPictureCollectionItem;
		320	if Item.Picture.Graphic<>nil then
		321	begin
		322	TempDIB := TDIB.Create;
		323	try
		324	TempDIB.SetSize(1, 1, 24);
		325	TempDIB.Canvas.Draw(0, 0, Item.Picture.Graphic);
		326	Item.TransparentColor := TempDIB.Pixels[0, 0];
		327	finally
		328	TempDIB.Free;
		329	end;
		330	end;
		331	Designer.Modified;
		332	end;
		333	finally
		334	Form.Free;
		335	end;
		336	end;
		337
		338	function TPictureCollectionItem_PictureProperty.GetAttributes: TPropertyAttributes;
		339	begin
		340	Result := [paDialog, paReadOnly];
		341	end;
		342
		343	function TPictureCollectionItem_PictureProperty.GetValue: string;
		344	begin
		345	if (TPicture(GetOrdValue).Graphic=nil) or (TPicture(GetOrdValue).Graphic.Empty) then
		346	Result := SNone
		347	else
		348	Result := Format('(%s)', [TPicture(GetOrdValue).Graphic.ClassName]);
		349	end;
		350
		351	{ TDXImageListEditor }
		352
		353	procedure TDXImageListEditor.ExecuteVerb(Index: Integer);
		354	var
		355	OpenDialog: TOpenDialog;
		356	SaveDialog: TSaveDialog;
		357	i: Integer;
		358	begin
		359	case Index of
		360	0: begin
		361	OpenDialog := TOpenDialog.Create(nil);
		362	try
		363	OpenDialog.DefaultExt := 'dxg';
		364	OpenDialog.Filter := SDXGOpenFileFilter;
		365	OpenDialog.Options := [ofPathMustExist, ofFileMustExist, ofAllowMultiSelect];
		366	if OpenDialog.Execute then
		367	begin
		368	if OpenDialog.FilterIndex=2 then
		369	begin
		370	for i:=0 to OpenDialog.Files.Count-1 do
		371	with TPictureCollectionItem.Create(TCustomDXImageList(Component).Items) do
		372	begin
		373	try
		374	Picture.LoadFromFile(OpenDialog.Files[i]);
		375	Name := ExtractFileName(OpenDialog.Files[i]);
		376	except
		377	Free;
		378	raise;
		379	end;
		380	end;
		381	end else
		382	TCustomDXImageList(Component).Items.LoadFromFile(OpenDialog.FileName);
		383	Designer.Modified;
		384	end;
		385	finally
		386	OpenDialog.Free;
		387	end;
		388	end;
		389	1: begin
		390	SaveDialog := TSaveDialog.Create(nil);
		391	try
		392	SaveDialog.DefaultExt := 'dxg';
		393	SaveDialog.Filter := SDXGFileFilter;
		394	SaveDialog.Options := [ofOverwritePrompt, ofPathMustExist];
		395	if SaveDialog.Execute then
		396	TCustomDXImageList(Component).Items.SaveToFile(SaveDialog.FileName);
		397	finally
		398	SaveDialog.Free;
		399	end;
		400	end;
		401	end;
		402	end;
		403
		404	function TDXImageListEditor.GetVerb(Index: Integer): string;
		405	begin
		406	case Index of
		407	0: Result := SOpen;
		408	1: Result := SSave;
		409	end;
		410	end;
		411
		412	function TDXImageListEditor.GetVerbCount: Integer;
		413	begin
		414	Result := 2;
		415	end;
		416
		417	{ TWaveProperty }
		418
		419	procedure TWaveProperty.Edit;
		420	var
		421	Form: TDelphiXWaveEditForm;
		422	begin
		423	Form := TDelphiXWaveEditForm.Create(nil);
		424	try
		425	Form.Wave := TWave(GetOrdValue);
		426	Form.ShowModal;
		427	if Form.Tag<>0 then
		428	begin
		429	SetOrdValue(Integer(Form.Wave));
		430	Designer.Modified;
		431	end;
		432	finally
		433	Form.Free;
		434	end;
		435	end;
		436
		437	function TWaveProperty.GetAttributes: TPropertyAttributes;
		438	begin
		439	Result := [paDialog, paReadOnly];
		440	end;
		441
		442	function TWaveProperty.GetValue: string;
		443	begin
		444	if TWave(GetOrdValue).Size=0 then
		445	Result := SNone
		446	else
		447	Result := Format('(%s)', [TObject(GetOrdValue).ClassName]);
		448	end;
		449
		450	{ TDXWaveEditor }
		451
		452	procedure TDXWaveEditor.Edit;
		453	var
		454	Form: TDelphiXWaveEditForm;
		455	begin
		456	Form := TDelphiXWaveEditForm.Create(nil);
		457	try
		458	Form.Wave := TCustomDXWave(Component).Wave;
		459	Form.ShowModal;
		460	if Form.Tag<>0 then
		461	begin
		462	TCustomDXWave(Component).Wave := Form.Wave;
		463	Designer.Modified;
		464	end;
		465	finally
		466	Form.Free;
		467	end;
		468	end;
		469
		470	procedure TDXWaveEditor.ExecuteVerb(Index: Integer);
		471	begin
		472	case Index of
		473	0: Edit;
		474	end;
		475	end;
		476
		477	function TDXWaveEditor.GetVerb(Index: Integer): string;
		478	begin
		479	case Index of
		480	0: Result := SSettingWave;
		481	end;
		482	end;
		483
		484	function TDXWaveEditor.GetVerbCount: Integer;
		485	begin
		486	Result := 1;
		487	end;
		488
		489	{ TDXWaveListEditor }
		490
		491	procedure TDXWaveListEditor.ExecuteVerb(Index: Integer);
		492	var
		493	OpenDialog: TOpenDialog;
		494	SaveDialog: TSaveDialog;
		495	i: Integer;
		496	begin
		497	case Index of
		498	0: begin
		499	OpenDialog := TOpenDialog.Create(nil);
		500	try
		501	OpenDialog.DefaultExt := 'dxw';
		502	OpenDialog.Filter := SDXWOpenFileFilter;
		503	OpenDialog.Options := [ofPathMustExist, ofFileMustExist, ofAllowMultiSelect];
		504	if OpenDialog.Execute then
		505	begin
		506	if OpenDialog.FilterIndex=2 then
		507	begin
		508	for i:=0 to OpenDialog.Files.Count-1 do
		509	with TWaveCollectionItem.Create(TCustomDXWaveList(Component).Items) do
		510	begin
		511	try
		512	Wave.LoadFromFile(OpenDialog.Files[i]);
		513	Name := ExtractFileName(OpenDialog.Files[i]);
		514	except
		515	Free;
		516	raise;
		517	end;
		518	end;
		519	end else
		520	TCustomDXWaveList(Component).Items.LoadFromFile(OpenDialog.FileName);
		521	Designer.Modified;
		522	end;
		523	finally
		524	OpenDialog.Free;
		525	end;
		526	end;
		527	1: begin
		528	SaveDialog := TSaveDialog.Create(nil);
		529	try
		530	SaveDialog.DefaultExt := 'dxw';
		531	SaveDialog.Filter := SDXWFileFilter;
		532	SaveDialog.Options := [ofOverwritePrompt, ofPathMustExist];
		533	if SaveDialog.Execute then
		534	TCustomDXWaveList(Component).Items.SaveToFile(SaveDialog.FileName);
		535	finally
		536	SaveDialog.Free;
		537	end;
		538	end;
		539	end;
		540	end;
		541
		542	function TDXWaveListEditor.GetVerb(Index: Integer): string;
		543	begin
		544	case Index of
		545	0: Result := SOpen;
		546	1: Result := SSave;
		547	end;
		548	end;
		549
		550	function TDXWaveListEditor.GetVerbCount: Integer;
		551	begin
		552	Result := 2;
		553	end;
		554
		555	{ TForceFeedbackEffectsProperty }
		556
		557	procedure TForceFeedbackEffectsProperty.Edit;
		558	var
		559	Form: TDelphiXFFEditForm;
		560	Effects: TForceFeedbackEffects;
		561	begin
		562	Effects := TForceFeedbackEffects(GetOrdValue);
		563
		564	Form := TDelphiXFFEditForm.Create(nil);
		565	try
		566	if Effects.Input is TJoystick then
		567	Form.Effects := Form.DXInput.Joystick.Effects
		568	else if Effects.Input is TKeyboard then
		569	Form.Effects := Form.DXInput.Keyboard.Effects
		570	else if Effects.Input is TMouse then
		571	Form.Effects := Form.DXInput.Mouse.Effects
		572	else Exit;
		573
		574	Form.Effects.Assign(TForceFeedbackEffects(GetOrdValue));
		575	Form.ShowModal;
		576	if Form.Tag<>0 then
		577	begin
		578	SetOrdValue(Integer(Form.Effects));
		579	Designer.Modified;
		580	end;
		581	finally
		582	Form.Free;
		583	end;
		584	end;
		585
		586	function TForceFeedbackEffectsProperty.GetAttributes: TPropertyAttributes;
		587	begin
		588	Result := [paDialog, paReadOnly];
		589	end;
		590
		591	function TForceFeedbackEffectsProperty.GetValue: string;
		592	begin
		593	if TForceFeedbackEffects(GetOrdValue).Count=0 then
		594	Result := SNone
		595	else
		596	Result := Format('(%s)', [TObject(GetOrdValue).ClassName]);
		597	end;
		598
		599	{ TDXInputEditor }
		600
		601	procedure TDXInputEditor.Edit;
		602	var
		603	Form: TDelphiXInputEditForm;
		604	begin
		605	Form := TDelphiXInputEditForm.Create(nil);
		606	try
		607	Form.DXInput := TCustomDXInput(Component);
		608	Form.ShowModal;
		609	if Form.Tag<>0 then
		610	Designer.Modified;
		611	finally
		612	Form.Free;
		613	end;
		614	end;
		615
		616	procedure TDXInputEditor.ExecuteVerb(Index: Integer);
		617	begin
		618	case Index of
		619	0: begin
		620	with TCustomDXInput(Component) do
		621	begin
		622	Joystick.ID := 0;
		623	Keyboard.KeyAssigns := DefKeyAssign;
		624	end;
		625	Designer.Modified;
		626	end;
		627	1: begin
		628	with TCustomDXInput(Component) do
		629	begin
		630	Joystick.ID := 0;
		631	Keyboard.KeyAssigns := DefKeyAssign2_1;
		632	end;
		633	Designer.Modified;
		634	end;
		635	2: begin
		636	with TCustomDXInput(Component) do
		637	begin
		638	Joystick.ID := 1;
		639	Keyboard.KeyAssigns := DefKeyAssign2_2;
		640	end;
		641	Designer.Modified;
		642	end;
		643	end;
		644	end;
		645
		646	function TDXInputEditor.GetVerb(Index: Integer): string;
		647	begin
		648	case Index of
		649	0: Result := SSinglePlayer;
		650	1: Result := SMultiPlayer1;
		651	2: Result := SMultiPlayer2;
		652	end;
		653	end;
		654
		655	function TDXInputEditor.GetVerbCount: Integer;
		656	begin
		657	Result := 3;
		658	end;
		659
		660	{ TGUIDProperty }
		661
		662	procedure TGUIDProperty.Edit;
		663	var
		664	Form: TDelphiXGUIDEditForm;
		665	begin
		666	Form := TDelphiXGUIDEditForm.Create(nil);
		667	try
		668	Form.GUID := GetStrValue;
		669	Form.ShowModal;
		670	if Form.Tag<>0 then
		671	begin
		672	SetStrValue(Form.GUID);
		673	Designer.Modified;
		674	end;
		675	finally
		676	Form.Free;
		677	end;
		678	end;
		679
		680	function TGUIDProperty.GetAttributes: TPropertyAttributes;
		681	begin
		682	Result := inherited GetAttributes + [paDialog];
		683	end;
		684
		685	end.

Subversion Repositories spacemission

spacemission/VCL_DELPHIX_D6/DXReg_original.pas – Rev 3