Chip 2002 September/Chip_2002-09_cd1.bin/zkuste/delphi/kompon/d45/OPTIONS.ZIP/Units/ValueEditor.pas

Pascal/Delphi Source File | 2002-06-14 | 6KB | 264 lines

unit ValueEditor;

interface

uses
  Windows, SysUtils, Forms, Controls, Dialogs, Graphics, DsgnIntf;

type
  TDefValueProperty = class(TPropertyEditor)
    function GetAttributes: TPropertyAttributes; override;
    function GetValue: string; override;
    procedure Edit; override;
  end;

procedure Register;

implementation

uses
  BooleanEditor, DateTimeEditor, FlagsEditor, ArrayEditor, Options;

{ TDefValueProperty }

function TDefValueProperty.GetAttributes: TPropertyAttributes;
begin
  result := [paReadOnly, paDialog];
end;

function TDefValueProperty.GetValue: string;
begin
  result := (GetComponent(0) as TOption).DefAsString;
end;

procedure EditAsString(I: TOption; Cap: string);
begin
  I.DefAsString := InputBox(Cap + ' as string', 'String &value', I.DefAsString);
end;

procedure EditAsInteger(I: TOption; Cap: string);
var
  s: string;
begin
  s := InputBox(Cap + ' as integer', 'Integer &value', I.DefAsString);
  try
    I.DefAsInteger := StrToInt(s);
  except
    raise EOptError.Create(oerNotInteger);
  end;
end;

procedure EditAsFloat(I: TOption; Cap: string);
var
  s: string;
begin
  s := InputBox(Cap + ' as float', 'Float &value', I.DefAsString);
  try
    I.DefAsFloat := StrToFloat(s);
  except
    raise EOptError.Create(oerNotFloat);
  end;
end;

procedure EditAsColor(I: TOption; Cap: string);
begin
  with TColorDialog.Create(Application) do
    try
      Color := I.DefAsColor;
      if Execute then
        I.DefAsColor := Color;
    finally
      Free;
    end;
end;

procedure EditAsFont(I: TOption; Cap: string);
var
  F: TFont;
begin
  with TFontDialog.Create(Application) do
    try
      F := I.DefAsFont;
      try
        Font.Assign(F);
      finally
        F.Free;
      end;
      if Execute then
        I.DefAsFont := Font;
    finally
      Free;
    end;
end;

procedure EditAsBoolean(I: TOption; Cap: string);
begin
  with TfrmBooleanEditor.Create(Application) do
    try
      Caption := Cap + ' as boolean';
      rgrBoolean.ItemIndex := ord(I.DefAsBoolean);
      if ShowModal = mrOK then
        I.DefAsBoolean := rgrBoolean.ItemIndex = 1;
    finally
      Free;
    end;
end;

procedure EditAsDateTime(I: TOption; Cap: string; K: TdtKind);
begin
  with TfrmDateTimeEditor.Create(Application) do
    try
      Kind := K;
      case K of
        dtkDate: begin
          Cap := Cap + ' as date';
          Date := I.DefAsDate;
        end;
        dtkTime: begin
          Cap := Cap + ' as time';
          Time := I.DefAsTime;
        end;
        dtkDateTime: begin
          Cap := Cap + ' as date and time';
          Date := I.DefAsDateTime;
          Time := I.DefAsDateTime;
        end;
      end;
      Caption := Cap;
      if ShowModal = mrOK then
        case K of
          dtkDate: I.DefAsDate := Date;
          dtkTime: I.DefAsTime := Time;
          dtkDateTime: I.DefAsDateTime := Date + Time;
        end;
    finally
      Free;
    end;
end;

procedure EditAsFlags(I: TOption; Cap: string);
var
  k: integer;
begin
  with TfrmFlagsEditor.Create(Application) do
    try
      Caption := Cap + ' as flags';
      OptName := I.Name;
      for k := 0 to I.DefCount - 1 do begin
        clbFlags.Items.Add(FlagName(k));
        clbFlags.Checked[k] := I.DefAsFlags[k];
      end;
      if ShowModal = mrOK then begin
        I.DefAsString := '';
        for k := 0 to clbFlags.Items.Count - 1 do
          I.DefAsFlags[k] := clbFlags.Checked[k];
      end;
    finally
      Free;
    end;
end;

procedure EditAsStrArray(I: TOption; Cap: string);
begin
  with TfrmArrayEditor.Create(Application) do
    try
      Caption := Cap + ' as string array';
      memArray.Lines.BeginUpdate;
      memArray.Lines.Text := I.DefAsString;
      memArray.Lines.EndUpdate;
      if ShowModal = mrOK then
        I.DefAsString := memArray.Lines.Text;
    finally
      Free;
    end;
end;

procedure EditAsIntArray(I: TOption; Cap: string);
var
  k: integer;
  s: string;
begin
  with TfrmArrayEditor.Create(Application) do
    try
      Caption := Cap + ' as integer array';
      memArray.Lines.BeginUpdate;
      memArray.Lines.Text := I.DefAsString;
      memArray.Lines.EndUpdate;
      if ShowModal = mrOK then begin
        s := I.DefAsString;
        I.DefAsString := '';
        for k := 0 to memArray.Lines.Count - 1 do
          try
            I.DefAsIntArray[k] := StrToInt(memArray.Lines[k]);
          except
            I.DefAsString := s;
            raise EOptError.Create(oerNotInteger);
          end;
      end;
    finally
      Free;
    end;
end;

procedure EditAsFloatArray(I: TOption; Cap: string);
var
  k: integer;
  s: string;
begin
  with TfrmArrayEditor.Create(Application) do
    try
      Caption := Cap + ' as float array';
      memArray.Lines.BeginUpdate;
      memArray.Lines.Text := I.DefAsString;
      memArray.Lines.EndUpdate;
      if ShowModal = mrOK then begin
        s := I.DefAsString;
        I.DefAsString := '';
        for k := 0 to memArray.Lines.Count - 1 do
          try
            I.DefAsFloatArray[k] := StrToFloat(memArray.Lines[k]);
          except
            I.DefAsString := s;
            raise EOptError.Create(oerNotFloat);
          end;
      end;
    finally
      Free;
    end;
end;

procedure TDefValueProperty.Edit;
var
  I: TOption;
  Cap, Old: string;
begin
  I := GetComponent(0) as TOption;
  Old := I.DefAsString;
  Cap := 'Editing ' + I.Name + '.DefValue';
  case I.OptionType of
    otString: EditAsString(I, Cap);
    otInteger: EditAsInteger(I, Cap);
    otFloat: EditAsFloat(I, Cap);
    otBoolean: EditAsBoolean(I, Cap);
    otColor: EditAsColor(I, Cap);
    otDate: EditAsDateTime(I, Cap, dtkDate);
    otTime: EditAsDateTime(I, Cap, dtkTime);
    otDateTime: EditAsDateTime(I, Cap, dtkDateTime);
    otFont: EditAsFont(I, Cap);
    otFlags: EditAsFlags(I, Cap);
    otStrArray: EditAsStrArray(I, Cap);
    otIntArray: EditAsIntArray(I, Cap);
    otFloatArray: EditAsFloatArray(I, Cap);
  end;
  if Old <> I.DefAsString then
    Designer.Modified;
end;

procedure Register;
begin
  RegisterPropertyEditor(TypeInfo(TDefValue), TOption, 'DefValue', TDefValueProperty);
end;

end.