peparade.pas

Delphi高级开发指南是开发程序的好帮手

  Result := Designer.GetPrivateDirectory;
end;

procedure THackColorElementProperty.GetProperties(Proc: TGetPropEditProc);
begin
end;

function THackColorElementProperty.GetPropInfo: PPropInfo;
begin
  Result := FPropList^[0].PropInfo;
end;

function THackColorElementProperty.GetPropType: PTypeInfo;
begin
  Result := FPropList^[0].PropInfo^.PropType^;
end;

function THackColorElementProperty.GetStrValue: string;
begin
  Result := GetStrValueAt(0);
end;

function THackColorElementProperty.GetStrValueAt(Index: Integer): string;
begin
  with FPropList^[Index] do Result := GetStrProp(Instance, PropInfo);
end;

function THackColorElementProperty.GetVarValue: Variant;
begin
  Result := GetVarValueAt(0);
end;

function THackColorElementProperty.GetVarValueAt(Index: Integer): Variant;
begin
  VarClear(Result);
  with FPropList^[Index] do Result := GetVariantProp(Instance, PropInfo);
end;

// changed...
function THackColorElementProperty.GetValue: string;
begin
  case fElement of
    0: Result := IntToStr (GetRValue (ColorToRGB (GetOrdValue)));
    1: Result := IntToStr (GetGValue (ColorToRGB (GetOrdValue)));
    2: Result := IntToStr (GetBValue (ColorToRGB (GetOrdValue)));
  end;
end;

procedure THackColorElementProperty.GetValues(Proc: TGetStrProc);
begin
end;

procedure THackColorElementProperty.Initialize;
begin
end;

procedure THackColorElementProperty.Modified;
begin
  Designer.Modified;
end;

procedure THackColorElementProperty.SetFloatValue(Value: Extended);
var
  I: Integer;
begin
  for I := 0 to FPropCount - 1 do
    with FPropList^[I] do SetFloatProp(Instance, PropInfo, Value);
  Modified;
end;

procedure THackColorElementProperty.SetMethodValue(const Value: TMethod);
var
  I: Integer;
begin
  for I := 0 to FPropCount - 1 do
    with FPropList^[I] do SetMethodProp(Instance, PropInfo, Value);
  Modified;
end;

procedure THackColorElementProperty.SetOrdValue(Value: Longint);
var
  I: Integer;
begin
  for I := 0 to FPropCount - 1 do
    with FPropList^[I] do SetOrdProp(Instance, PropInfo, Value);
  Modified;
end;

procedure THackColorElementProperty.SetPropEntry(Index: Integer;
  AInstance: TComponent; APropInfo: PPropInfo);
begin
  with FPropList^[Index] do
  begin
    Instance := AInstance;
    PropInfo := APropInfo;
  end;
end;

procedure THackColorElementProperty.SetStrValue(const Value: string);
var
  I: Integer;
begin
  for I := 0 to FPropCount - 1 do
    with FPropList^[I] do SetStrProp(Instance, PropInfo, Value);
  Modified;
end;

procedure THackColorElementProperty.SetVarValue(const Value: Variant);
var
  I: Integer;
begin
  for I := 0 to FPropCount - 1 do
    with FPropList^[I] do SetVariantProp(Instance, PropInfo, Value);
  Modified;
end;

procedure THackColorElementProperty.Revert;
var
  I: Integer;
begin
  for I := 0 to FPropCount - 1 do
    with FPropList^[I] do Designer.Revert(Instance, PropInfo);
end;

// changed...
procedure THackColorElementProperty.SetValue(const Value: string);
var
  Val: Integer;
  Col: TColor;
begin
  // get the value
  Val := StrToInt (Value);
  // impose a limit
  if Val < 0 then Val := 0;
  if Val > 255 then Val := 255;
  // get the 'older' color
  Col := ColorToRGB(GetOrdValue);
  case fElement of
    0: SetOrdValue (RGB (
      Val, GetGValue (Col),  GetBValue (Col)));
    1: SetOrdValue (RGB (
      GetRValue (Col), Val,  GetBValue (Col)));
    2: SetOrdValue (RGB (
      GetRValue (Col), GetGValue (Col),  Val));
  end;
end;

function THackColorElementProperty.ValueAvailable: Boolean;
var
  I: Integer;
  S: string;
begin
  Result := True;
  for I := 0 to FPropCount - 1 do
  begin
    if csCheckPropAvail in
      (FPropList^[I].Instance as TComponent).ComponentStyle then
    begin
      try
        S := GetValue;
        AllEqual;
      except
        Result := False;
      end;
      Exit;
    end;
  end;
end;

/////////////////////////////

(******************* non working version...

constructor TColorElementProperty. Create (
  Element: Integer; Designer: TFormDesigner;
  PropCount: Integer);
begin
  // doesn't work: private
  inherited Create (Designer, PropCount);
  fElement := Element;
end;

function TColorElementProperty.GetName: string;
begin
  case fElement of
    0: Result := 'Red';
    1: Result := 'Green';
    2: Result := 'Blue';
  end;
end;

function TColorElementProperty.GetValue: string;
begin
  case fElement of
    0: Result := IntToStr (GetRValue (ColorToRGB (GetOrdValue)));
    1: Result := IntToStr (GetGValue (ColorToRGB (GetOrdValue)));
    2: Result := IntToStr (GetBValue (ColorToRGB (GetOrdValue)));
  end;
end;

procedure TColorElementProperty.SetValue(const Value: string);
var
  Val: Integer;
  Col: TColor;
begin
  // get the value
  Val := StrToInt (Value);
  // impose a limit
  if Val < 0 then Val := 0;
  if Val > 255 then Val := 255;
  // get the 'older' color
  Col := ColorToRGB(GetOrdValue);
  case fElement of
    0: SetOrdValue (RGB (
      Val, GetGValue (Col),  GetBValue (Col)));
    1: SetOrdValue (RGB (
      GetRValue (Col), Val,  GetBValue (Col)));
    2: SetOrdValue (RGB (
      GetRValue (Col), GetGValue (Col),  Val));
  end;
end;
end non working version ***************************)

// SubColor methods

function TSubColorProperty.GetAttributes: TPropertyAttributes;
begin
  Result := inherited GetAttributes + [paSubProperties] - [paMultiSelect];
end;

procedure TSubColorProperty.GetProperties(Proc: TGetPropEditProc);
var
  ElementIndex: Integer;
begin
  for ElementIndex := 0 to 2 do
    Proc (TPropertyEditor (THackColorElementProperty.Create (
      ElementIndex, Designer, GetComponent (0) as TComponent,
      GetPropInfo)));
end;

// TDialogIntProperty class

function TDialogIntProperty.GetAttributes:
  TPropertyAttributes;
begin
  Result := [paDialog, paMultiSelect];
end;

procedure TDialogIntProperty.Edit;
var
  PEForm: TSpinForm;
begin
  PEForm := TSpinForm.Create (Application);
  try
    PEForm.UpDown1.Position := GetOrdValue;
    if PEForm.ShowModal = mrOK then
      SetOrdValue (PEForm.UpDown1.Position);
  finally
    PEForm.Free;
  end;
end;

// TAutoIntegerProperty class

function TAutoIntegerProperty.GetAttributes:
  TPropertyAttributes;
begin
  Result := inherited GetAttributes + [paAutoUpdate];
end;

// property editors registration

procedure Register;
begin
  RegisterComponents ('DDHB',
    [TDdhDummyButton, TDdhDummyLabel]);

  // install the property editors
  RegisterPropertyEditor (TypeInfo (TCaption),
    TDdhDummyButton, 'Caption', TUpperProperty);

  RegisterPropertyEditor (TypeInfo (Integer),
    TDdhDummyButton, 'Width', TNumListProperty);
  RegisterPropertyEditor (TypeInfo (Integer),
    TDdhDummyButton, 'Height', TNumListProperty);

  RegisterPropertyEditor (TypeInfo (string),
    TDdhDummyButton, 'Hint', THintListProperty);

  RegisterPropertyEditor (TypeInfo (TColor),
    TDdhDummyLabel, 'Color', TSubColorProperty);

  RegisterPropertyEditor (TypeInfo(Integer),
    TDdhDummyLabel, '', TDialogIntProperty);

  RegisterPropertyEditor (TypeInfo(Integer),
    TDdhDummyLabel, 'Top', TAutoIntegerProperty);
  RegisterPropertyEditor (TypeInfo(Integer),
    TDdhDummyLabel, 'Left', TAutoIntegerProperty);
end;

end.