⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 vrpropedit.pas

📁 作工控的好控件
💻 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 + -