📄 vrpropedit.pas
字号:
{*****************************************************}
{ }
{ Varian Component Workshop }
{ }
{ Varian Software NL (c) 1996-2000 }
{ All Rights Reserved }
{ }
{*****************************************************}
unit VrPropEdit;
{$I VRLIB.INC}
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
DsgnIntf, VrClasses, VrBitmapsDlg, VrPaletteDlg, VrAudio, VrWaveDlg;
type
TVrVersionProperty = class(TStringProperty)
public
function GetAttributes: TPropertyAttributes; override;
end;
TVrPaletteProperty = class(TClassProperty)
public
procedure Edit; override;
function GetAttributes: TPropertyAttributes; override;
end;
TVrBitmapsProperty = class(TClassProperty)
public
procedure Edit; override;
function GetAttributes: TPropertyAttributes; override;
end;
TVrWaveSoundProperty = class(TClassProperty)
public
procedure Edit; override;
function GetAttributes: TPropertyAttributes; override;
end;
TVrBitmapListEditor = class(TDefaultEditor)
protected
procedure EditProperty(PropertyEditor: TPropertyEditor;
var Continue, FreeEditor: Boolean); override;
public
procedure ExecuteVerb(Index: Integer); override;
function GetVerb(Index: Integer): string; override;
function GetVerbCount: Integer; override;
end;
TVrStringListEditor = class(TDefaultEditor)
protected
procedure EditProperty(PropertyEditor: TPropertyEditor;
var Continue, FreeEditor: Boolean); override;
public
procedure ExecuteVerb(Index: Integer); override;
function GetVerb(Index: Integer): string; override;
function GetVerbCount: Integer; override;
end;
TVrWaveEditor = class(TDefaultEditor)
protected
procedure EditProperty(PropertyEditor: TPropertyEditor;
var Continue, FreeEditor: Boolean); override;
public
procedure ExecuteVerb(Index: Integer); override;
function GetVerb(Index: Integer): string; override;
function GetVerbCount: Integer; override;
end;
TVrFileNameProperty = class(TStringProperty)
public
procedure Edit; override;
function GetAttributes: TPropertyAttributes; override;
end;
implementation
{ TVrVersionProperty }
function TVrVersionProperty.GetAttributes: TPropertyAttributes;
begin
Result := [paReadOnly];
end;
{ TVrBitmapsProperty }
function TVrBitmapsProperty.GetAttributes: TPropertyAttributes;
begin
Result := [paDialog] - [paSubProperties];
end;
procedure TVrBitmapsProperty.Edit;
var
List: TVrBitmaps;
ListEditor: TVrBitmapListDialog;
Res: TModalResult;
begin
List := TVrBitmaps(GetOrdValue);
ListEditor := TVrBitmapListDialog.Create(nil);
try
ListEditor.Bitmaps.Assign(List);
Res := ListEditor.ShowModal;
if Res = mrOk then
begin
List.Assign(ListEditor.Bitmaps);
Designer.Modified;
end;
finally
ListEditor.Free;
end;
end;
{ TVrWaveSoundProperty }
function TVrWaveSoundProperty.GetAttributes: TPropertyAttributes;
begin
Result := [paDialog] - [paSubProperties];
end;
procedure TVrWaveSoundProperty.Edit;
var
Wave: TVrAudioData;
WaveEditor: TVrWaveSoundDialog;
Res: TModalResult;
begin
Wave := TVrAudioData(GetOrdValue);
WaveEditor := TVrWaveSoundDialog.Create(nil);
try
WaveEditor.VrWave.Sound.Assign(Wave);
WaveEditor.UpdateControls;
Res := WaveEditor.ShowModal;
if Res = mrOk then
begin
Wave.Assign(WaveEditor.VrWave.Sound);
Designer.Modified;
end;
finally
WaveEditor.Free;
end;
end;
{ TVrBitmapListEditor }
procedure TVrBitmapListEditor.EditProperty(PropertyEditor: TPropertyEditor;
var Continue, FreeEditor: Boolean);
var
PropName: string;
begin
PropName := PropertyEditor.GetName;
if (CompareText(PropName, 'Bitmaps') = 0) then
begin
PropertyEditor.Edit;
Continue := False;
end;
end;
function TVrBitmapListEditor.GetVerbCount: Integer;
begin
Result := 1;
end;
function TVrBitmapListEditor.GetVerb(Index: Integer): string;
begin
if Index = 0 then
Result := 'Bitmaps Editor!'
else Result := '';
end;
procedure TVrBitmapListEditor.ExecuteVerb(Index: Integer);
begin
if Index = 0 then Edit;
end;
{ TVrStringListEditor }
procedure TVrStringListEditor.EditProperty(PropertyEditor: TPropertyEditor;
var Continue, FreeEditor: Boolean);
var
PropName: string;
begin
PropName := PropertyEditor.GetName;
if (CompareText(PropName, 'Strings') = 0) then
begin
PropertyEditor.Edit;
Continue := False;
end;
end;
function TVrStringListEditor.GetVerbCount: Integer;
begin
Result := 1;
end;
function TVrStringListEditor.GetVerb(Index: Integer): string;
begin
if Index = 0 then
Result := 'StringList Editor!'
else Result := '';
end;
procedure TVrStringListEditor.ExecuteVerb(Index: Integer);
begin
if Index = 0 then Edit;
end;
{ TVrPaletteProperty }
procedure TVrPaletteProperty.Edit;
var
Palette: TVrPalette;
PaletteEditor: TVrPaletteDlg;
Res: TModalResult;
begin
Palette := TVrPalette(GetOrdValue);
PaletteEditor := TVrPaletteDlg.Create(nil);
try
PaletteEditor.EditorPalette := Palette;
Res := PaletteEditor.ShowModal;
if Res = mrOk then
Designer.Modified;
finally
PaletteEditor.Free;
end;
end;
function TVrPaletteProperty.GetAttributes: TPropertyAttributes;
begin
Result := [paDialog, paSubProperties];
end;
{ TVrWaveEditor }
procedure TVrWaveEditor.EditProperty(PropertyEditor: TPropertyEditor;
var Continue, FreeEditor: Boolean);
var
PropName: string;
begin
PropName := PropertyEditor.GetName;
if (CompareText(PropName, 'Sound') = 0) then
begin
PropertyEditor.Edit;
Continue := False;
end;
end;
function TVrWaveEditor.GetVerbCount: Integer;
begin
Result := 1;
end;
function TVrWaveEditor.GetVerb(Index: Integer): string;
begin
if Index = 0 then
Result := 'Wave Editor!'
else Result := '';
end;
procedure TVrWaveEditor.ExecuteVerb(Index: Integer);
begin
if Index = 0 then Edit;
end;
{ TVrFileNameProperty }
function TVrFileNameProperty.GetAttributes: TPropertyAttributes;
begin
Result := [paDialog] - [paSubProperties];
end;
procedure TVrFileNameProperty.Edit;
var
FileName: string;
OpenDlg: TOpenDialog;
begin
FileName := GetValue;
OpenDlg := TOpenDialog.Create(nil);
try
OpenDlg.Title := 'Select';
OpenDlg.FileName := '*.*';
OpenDlg.Filter := 'All Files (*.*)|*.*';
OpenDlg.InitialDir := ExtractFileDir(FileName);
if OpenDlg.Execute then
SetValue(OpenDlg.FileName);
finally
OpenDlg.Free;
end;
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -