dialogbuttoncontrols.pas

學習資料網上下載

  inherited;
  params.Style := params.Style or BS_GROUPBOX
end;

class function TGroupBoxControlInfo.GetDescription: string;
begin
  Result := rstGroupBox;
end;

{ TCheckboxControlInfo }

class procedure TCheckboxControlInfo.CreateControlParams(
  var params: TCreateControlParams);
begin
  inherited;
  params.Style := params.Style or (BS_AUTOCHECKBOX or WS_TABSTOP)
end;

class function TCheckboxControlInfo.GetDescription: string;
begin
  Result := rstCheckBox
end;

function TCheckboxControlInfo.GetPropertyCount(
  kind: TPropertyKind): Integer;
begin
  Result := inherited GetPropertyCount (kind) + CheckBoxControlPropertyCount [kind]
end;

function TCheckboxControlInfo.GetPropertyEnumCount(kind: TPropertyKind;
  idx: Integer): Integer;
begin
  if idx < inherited GetPropertyCount (kind) then
    Result := inherited GetPropertyEnumCount (kind, idx)
  else
  begin
//    Dec (idx, inherited GetPropertyCount (kind));
    Result := 0
  end
end;

function TCheckboxControlInfo.GetPropertyEnumName(kind: TPropertyKind; idx,
  enum: Integer): string;
begin
  if idx < inherited GetPropertyCount (kind) then
    Result := inherited GetPropertyEnumName (kind, idx, enum)
  else
  begin
//    Dec (idx, inherited GetPropertyCount (kind));
    Result := ''
  end
end;

function TCheckboxControlInfo.GetPropertyName(kind: TPropertyKind;
  idx: Integer): string;
begin
  if idx < inherited GetPropertyCount (kind) then
    Result := inherited GetPropertyName (kind, idx)
  else
  begin
    Dec (idx, inherited GetPropertyCount (kind));
    Result := '';
    case kind of
//      pkGeneral : Result := CheckBoxControlPropertyGeneralName [idx];
      pkStyle   : Result := CheckBoxControlPropertyStyleName [idx];
//      pkExtended : Result := CheckBoxControlPropertyExtendedName [idx];
    end
  end
end;

function TCheckboxControlInfo.GetPropertyType(kind: TPropertyKind;
  idx: Integer): TPropertyType;
begin
  if idx < inherited GetPropertyCount (kind) then
    Result := inherited GetPropertyType (kind, idx)
  else
  begin
    Dec (idx, inherited GetPropertyCount (kind));
    Result := ptInteger;
    case kind of
//      pkGeneral : Result := CheckBoxControlPropertyGeneralType [idx];
      pkStyle   : Result := CheckBoxControlPropertyStyleType [idx];
//      pkExtended : Result := CheckBoxControlPropertyExtendedType [idx];
    end
  end
end;

function TCheckboxControlInfo.GetPropertyValue(kind: TPropertyKind;
  idx: Integer): Variant;
var
  tp : Integer;
begin
  if idx < inherited GetPropertyCount (kind) then
    Result := inherited GetPropertyValue (kind, idx)
  else
  begin
    Dec (idx, inherited GetPropertyCount (kind));

    tp := Style and $f;

    case kind of
      pkStyle :
        case idx of
          0 : Result := (tp = BS_AUTOCHECKBOX) or (tp = BS_AUTO3STATE);
          1 : Result := HasStyle [BS_LEFTTEXT];
          2 : Result := (tp = BS_3STATE) or (tp = BS_AUTO3STATE);
          3 : Result := HasStyle [BS_PUSHLIKE];
        end;
    end
  end
end;

procedure TCheckboxControlInfo.SetPropertyValue(kind: TPropertyKind;
  idx: Integer; const Value: Variant);
var
  tp : Integer;
  recreateRequired : Boolean;
begin
  recreateRequired := False;
  if idx < inherited GetPropertyCount (kind) then
    inherited SetPropertyValue (kind, idx, Value)
  else
  begin
    Dec (idx, inherited GetPropertyCount (kind));

    tp := Style and $f;
    case kind of
      pkStyle :
        case idx of
          0 :
            case Boolean (Value) of
              False : if (tp = BS_AUTOCHECKBOX) then
                        SetMaskedStyle (BS_CHECKBOX, $f)
                      else
                        if (tp = BS_AUTO3STATE) then
                          SetMaskedStyle (BS_3STATE, $f);
              True :  if (tp = BS_CHECKBOX) then
                        SetMaskedStyle (BS_AUTOCHECKBOX, $f)
                      else
                        if tp = BS_3STATE then
                          SetMaskedStyle (BS_AUTO3STATE, $f)
            end;

          1 : begin HasStyle [BS_LEFTTEXT] := Value; recreateRequired := True end;
          2 : case Boolean (Value) of
                False : if tp = BS_3STATE then
                          SetMaskedStyle (BS_CHECKBOX, $f)
                        else
                          if tp = BS_AUTO3STATE then
                            SetMaskedStyle (BS_AUTOCHECKBOX, $f);
                True :  if tp = BS_CHECKBOX then
                          SetMaskedStyle (BS_3STATE, $f)
                        else
                          if tp = BS_AUTOCHECKBOX then
                            SetMaskedStyle (BS_AUTO3STATE, $f)
              end;
          3 : begin HasStyle [BS_PUSHLIKE] := Value; recreateRequired := True end;

        end;
    end
  end;
  if recreateRequired then
    RecreateWnd
end;

{ TRadiobuttonControlInfo }

class procedure TRadiobuttonControlInfo.CreateControlParams(
  var params: TCreateControlParams);
begin
  inherited;
  params.Style := params.Style or BS_AUTORADIOBUTTON or WS_TABSTOP;
end;

class function TRadiobuttonControlInfo.GetDescription: string;
begin
  Result := rstRadioButton;
end;

function TRadioButtonControlInfo.GetPropertyCount(
  kind: TPropertyKind): Integer;
begin
  Result := inherited GetPropertyCount (kind) + RadioButtonControlPropertyCount [kind]
end;

function TRadioButtonControlInfo.GetPropertyEnumCount(kind: TPropertyKind;
  idx: Integer): Integer;
begin
  if idx < inherited GetPropertyCount (kind) then
    Result := inherited GetPropertyEnumCount (kind, idx)
  else
  begin
//    Dec (idx, inherited GetPropertyCount (kind));
    Result := 0
  end
end;

function TRadioButtonControlInfo.GetPropertyEnumName(kind: TPropertyKind; idx,
  enum: Integer): string;
begin
  if idx < inherited GetPropertyCount (kind) then
    Result := inherited GetPropertyEnumName (kind, idx, enum)
  else
  begin
//    Dec (idx, inherited GetPropertyCount (kind));
    Result := ''
  end
end;

function TRadioButtonControlInfo.GetPropertyName(kind: TPropertyKind;
  idx: Integer): string;
begin
  if idx < inherited GetPropertyCount (kind) then
    Result := inherited GetPropertyName (kind, idx)
  else
  begin
    Dec (idx, inherited GetPropertyCount (kind));
    Result := '';
    case kind of
//      pkGeneral : Result := RadioButtonControlPropertyGeneralName [idx];
      pkStyle   : Result := RadioButtonControlPropertyStyleName [idx];
//      pkExtended : Result := RadioButtonControlPropertyExtendedName [idx];
    end
  end
end;

function TRadioButtonControlInfo.GetPropertyType(kind: TPropertyKind;
  idx: Integer): TPropertyType;
begin
  if idx < inherited GetPropertyCount (kind) then
    Result := inherited GetPropertyType (kind, idx)
  else
  begin
    Dec (idx, inherited GetPropertyCount (kind));
    Result := ptInteger;
    case kind of
//      pkGeneral : Result := RadioButtonControlPropertyGeneralType [idx];
      pkStyle   : Result := RadioButtonControlPropertyStyleType [idx];
//      pkExtended : Result := RadioButtonControlPropertyExtendedType [idx];
    end
  end
end;

function TRadioButtonControlInfo.GetPropertyValue(kind: TPropertyKind;
  idx: Integer): Variant;
var
  tp : Integer;
begin
  if idx < inherited GetPropertyCount (kind) then
    Result := inherited GetPropertyValue (kind, idx)
  else
  begin
    Dec (idx, inherited GetPropertyCount (kind));

    tp := Style and $f;

    case kind of
      pkStyle :
        case idx of
          0 : Result := tp = BS_AUTORADIOBUTTON;
          1 : Result := HasStyle [BS_LEFTTEXT];
          2 : Result := HasStyle [BS_PUSHLIKE];
        end;
    end
  end
end;

procedure TRadioButtonControlInfo.SetPropertyValue(kind: TPropertyKind;
  idx: Integer; const Value: Variant);
var
  tp : Integer;
  recreateRequired : Boolean;
begin
  recreateRequired := False;
  if idx < inherited GetPropertyCount (kind) then
    inherited SetPropertyValue (kind, idx, Value)
  else
  begin
    Dec (idx, inherited GetPropertyCount (kind));

    tp := Style and $f;
    case kind of
      pkStyle :
        case idx of
          0 :
            case Boolean (Value) of
              False : if (tp = BS_AUTORADIOBUTTON) then
                        SetMaskedStyle (BS_RADIOBUTTON, $f);
              True :  if (tp = BS_RADIOBUTTON) then
                        SetMaskedStyle (BS_AUTORADIOBUTTON, $f)
            end;

          1 : begin HasStyle [BS_LEFTTEXT] := Value; recreateRequired := True end;
          2 : begin HasStyle [BS_PUSHLIKE] := Value; recreateRequired := True end;

        end;
    end
  end;
  if recreateRequired then
    RecreateWnd
end;

{ TBasicButtonControlInfo }

function TBasicButtonControlInfo.GetPropertyCount(
  kind: TPropertyKind): Integer;
begin
  Result := inherited GetPropertyCount (kind) + BasicButtonControlPropertyCount [kind]
end;

function TBasicButtonControlInfo.GetPropertyEnumCount(kind: TPropertyKind;
  idx: Integer): Integer;
begin
  if idx < inherited GetPropertyCount (kind) then
    Result := inherited GetPropertyEnumCount (kind, idx)
  else
  begin
    Dec (idx, inherited GetPropertyCount (kind));
    Result := 0;
    case kind of
      pkStyle :
        case idx of
          0 : Result := 4;
        end
    end
  end
end;

function TBasicButtonControlInfo.GetPropertyEnumName(kind: TPropertyKind;
  idx, enum: Integer): string;
begin
  if idx < inherited GetPropertyCount (kind) then
    Result := inherited GetPropertyEnumName (kind, idx, enum)
  else
  begin
    Dec (idx, inherited GetPropertyCount (kind));
    Result := '';

    case kind of
      pkStyle :
        case idx of
          0 :
            case enum of
              0 : Result := rstDefault;
              1 : Result := rstTop;
              2 : Result := rstBottom;
              3 : Result := rstCenter
            end
        end
    end
  end
end;

function TBasicButtonControlInfo.GetPropertyName(kind: TPropertyKind;
  idx: Integer): string;
begin
  if idx < inherited GetPropertyCount (kind) then
    Result := inherited GetPropertyName (kind, idx)
  else
  begin
    Dec (idx, inherited GetPropertyCount (kind));
    Result := '';
    case kind of
//      pkGeneral : Result := BasicButtonControlPropertyGeneralName [idx];
      pkStyle   : Result := BasicButtonControlPropertyStyleName [idx];
//      pkExtended : Result := BasicButtonControlPropertyExtendedName [idx];
    end
  end
end;

function TBasicButtonControlInfo.GetPropertyType(kind: TPropertyKind;
  idx: Integer): TPropertyType;
begin
  if idx < inherited GetPropertyCount (kind) then
    Result := inherited GetPropertyType (kind, idx)
  else
  begin
    Dec (idx, inherited GetPropertyCount (kind));
    Result := ptInteger;
    case kind of
//      pkGeneral : Result := BasicButtonControlPropertyGeneralType [idx];
      pkStyle   : Result := BasicButtonControlPropertyStyleType [idx];
//      pkExtended : Result := BasicButtonControlPropertyExtendedType [idx];
    end
  end
end;

function TBasicButtonControlInfo.GetPropertyValue(kind: TPropertyKind;
  idx: Integer): Variant;
begin
  if idx < inherited GetPropertyCount (kind) then
    Result := inherited GetPropertyValue (kind, idx)
  else
  begin
    Dec (idx, inherited GetPropertyCount (kind));

    case kind of
      pkStyle :
        case idx of
          0 : Result := (Style and $c00) shr 10;
          1 : Result := HasStyle [BS_MULTILINE];
          2 : Result := HasStyle [BS_OWNERDRAW];
        end
    end
  end
end;

procedure TBasicButtonControlInfo.SetPropertyValue(kind: TPropertyKind;
  idx: Integer; const Value: Variant);
begin
  if idx < inherited GetPropertyCount (kind) then
    inherited SetPropertyValue (kind, idx, Value)
  else
  begin
    Dec (idx, inherited GetPropertyCount (kind));

    case kind of
      pkStyle :
        case idx of
          0 : SetMaskedStyle (Value shl 10, $c00);
          1 : HasStyle [BS_MULTILINE] := Value;
          2 : HasStyle [BS_OWNERDRAW] := Value;
        end;
    end
  end
end;

end.