Как взять размер и ... , Как сделать?

Вот понадобился потомок от панели. И загвоздка вот в чём. Мне надо установить размер панели в зависимости от размера checkbox, но .. как взять размер checkbox? Он автоматически расширяется вниз (если строки не входят по длине, то перенос на след строку). Размер панели почему-то устанавливается - (заголовок + одна строка checkbox)

unit svdTOPpanel;
 
interface
 
uses
  SysUtils, Classes, Controls, ExtCtrls, StdCtrls, Graphics, CheckBoxEx;
 
type
  TsvdTOPpanel = class(TPanel)
  private
    FColor: TShape;
    FCaptionTitle: TLabel;
    FCheckBox: TCheckBoxEx;
    procedure AutoHeight();
 
 
    { Private declarations }
  protected
    { Protected declarations }
 
  public
    { Public declarations }
 
  published
    { Published declarations }
    constructor Create(AOwner: TComponent); override;
  end;
 
procedure Register;
 
 
implementation
 
uses uTest;
 
procedure Register;
begin
  RegisterComponents('Standard', [TsvdTOPpanel]);
end;
 
constructor TsvdTOPpanel.Create(AOwner: TComponent);
begin
 inherited Create(AOwner);
//настройка панели
  Left := 100;
  Top := 100;
  Height := 65;
  Width := 500;
  ParentColor := True;
  Font.Name := 'Tahoma';
  Font.Size := 10;
  Caption := '';
  Color := clBlue;
  BevelOuter := bvNone;
  Visible := True;
  
//фон
  FColor := TShape.Create(Self);
  with FColor do
    begin
      Parent := Self;
      Align := alClient;
      Brush.Color := clInfoBk
    end;
 
//текст в верхнем левом углу
  FCaptionTitle := TLabel.Create(Self);
  with FCaptionTitle do
    begin
      Parent := Self;
      AutoSize := False;
      Top := 2;
      Left := 2;
      Height := 18;
      Width := (Self.Width - Top - 2);
      Anchors := [akLeft,akTop,akRight];
      //Transparent := True;
      Caption := ' ' + 'EE';
      Color := clInactiveCaption;
    end;
 
// checkbox
  FCheckBox := TCheckBoxEx.Create(Self);
  with FCheckBox do
    begin
      Parent := Self;
      Left := 5;
      Constraints.MaxWidth := (Self.Width - Top - 10);
      Constraints.MinWidth := (Self.Width - Top - 10);
      AutoSize := True;
      WordWrap := True;
      Top := FCaptionTitle.Height + 3;
      //Anchors := [akLeft,akTop,akRight, akBottom];
      //Transparent := True;
      Caption := '//svdCheckBox.Font.Size := StrToInt(Edit1.Text); //svdCheckBox.Font.Size := StrToInt(Edit1.Text); //svdCheckBox.Font.Size := StrToInt(Edit1.Text); //svdCheckBox.Font.Size := StrToInt(Edit1.Text);';
      Color := FColor.Brush.Color;
    end;
    AutoHeight();
end;
 
procedure TsvdTOPpanel.AutoHeight();
var
  Value: byte;
  Top: byte;
  //Height: byte;
begin
  Top := (FCaptionTitle.Top + FCaptionTitle.Height + 2);
  Self.Height := FCheckBox.Height + Top + 2; // вот сдесь некорректно берЁтся Height
  //Value := Self.Height;
  //fTest.Label1.Caption := IntToStr(FCheckBox.Height)+ ' ' + IntToStr( Top);
//
end;
 
end.

И ещё. Надо, что бы при изменении Caption вызывалась процедура AutoHeight. Как это сделать?

Сообщение отредактировано: Mammoth - 21.02.06, 06:58

В процедуре AutoHeight сначала высчитывай количество строк текста FCheckBox, затем исходя из полученного размера устанавливай Height панели, только после этого устанавливай свойство FCheckBox.Caption.

Цитата zubr @ 21.02.06, 08:23

В процедуре AutoHeight сначала высчитывай количество строк текста FCheckBox

FCheckBox = TCheckboxEx - т.е. он автоматически подстраивается под текст. Осталось взять его высоту. Но как?

Если процедуру сделать доступной и вызвать, то всё в порядке. Но мне хочется, что бы сам компонент делал.

Может познакомишь с кодом компонента TCheckBoxEx?

procedure TsvdTOPpanel.AutoHeight();
var
   ATop: integer;  // (!) вместо Top: byte;
   // byte: имеет диапазон всего-то 0..255, так что более 255 символов высоту задать не получится
   // Top: неудачное название локальной переменной, т.к. имеется свойство TsvdTOPpanel.Top
begin
   Self.Height := FCheckBox.Height + FCheckBox.Top + 2; // тогда панель будет иметь высоту на 2 пикселя больше, чем надо для отображения FCheckBox
end;
 
// как я понимаю это продолжение темы: http://forum.sources.ru/index.php?showtopic=133392
// для TExCheckBox надо отловить событие присвоения ему текста:
procedure TExCheckBox.WndProc(var Msg: TMessage);
begin
   inherited;
 
   // отлавдиваем только установку текста
   if Msg.Msg = WM_SETTEXT then
   begin
      // вычисление собственной ширины
      Width := CalcTextWidth( Self, Self.Font, 'XX' + PChar(Msg.LParam) );
 
      // изменение ширины владельца "под себя"
      Parent.Width := 2 * Left + Width;
   end;
end;

Более обший вариант процы вычисления ширины текста CalcTextWidth:

function CalcTextWidth( Win: TWinControl; Fnt: TFont; const Text: string ) : integer;
var
   btnDC: HDC;
   H    : integer;
   R    : TRect;
begin
   Result := -1;
   if (Win = nil) or (Text = '') then exit;
 
   // создаем канву Checkbox'а для получения информации по тексту
   btnDC := GetDC( Win.Handle );
   try // finally
 
      // задаем шрифт тот же, что и у кнопки
      if Fnt <> nil then
         SelectObject( btnDC, Fnt.Handle );
 
      // запрос ширины текста
      FillChar( R, sizeof(R), 0);
      H := DrawTextEx( btnDC, PChar(Text), length(Text), R, DT_CALCRECT, nil );
 
      if H = 0 then
         // ShowMessage( 'Fail to get width'#13'Error: '+ SysErrorMessage(GetLastError) )
         Result := Win.Width
      else
         Result:= R.Right - R.Left; // желанная ширина
 
   finally
      // освоболдим ресурсы (фонт не освобождаем, так как его владаелец - Checkbox)
      ReleaseDC( Win.Handle, btnDC );
   end; // finally
 
end;

Еще вот что:
Ты уверен что надо

Цитата Mammoth @ 21.02.06, 06:51

with FCheckBox do begin
...
Constraints.MaxWidth := (Self.Width - Top - 10);
Constraints.MinWidth := (Self.Width - Top - 10);
...

?
может быть просто задать ширину и повесить якоря:

   with FCheckBox do begin
   ...
      Width:= (Self.Width - Top - 10); // просто задать ширину вместо ограничений
      Anchors := [ alLeft, alRight, alTop, alBottom];

тогда, если панель будет "следить за размером своей формы", то CheckBox будет изменять совй размер самостоятельно.

RuSA, а в этом коде могут быть проблемы? Я его немного изменил.

unit svdTOPpanel;
 
interface
 
uses
  SysUtils, Classes, Controls, ExtCtrls, StdCtrls, Graphics, CheckBoxEx, Messages;
  
type
  TsvdTOPpanel = class(TPanel)
  private
    FColor: TShape;
    FTitle: TShape;
    FCaptionTitle: TLabel;
    FTextNum: string;
    FTextCh: string;
    FCheckBox: TCheckBoxEx;
    procedure SetTextNum(Value: string);
    procedure SetTextCh(Value: string);
    { Private declarations }
  protected
    { Protected declarations }
    procedure Resize; override; //изменение размера
  public
    { Public declarations }
    
  published
    { Published declarations }
    procedure AutoHeight;
    property TextNum: string read FTextNum write SetTextNum;
    property TextCh: string read FTextCh write SetTextCh;
    constructor Create(AOwner: TComponent); override;
  end;
 
procedure Register;
 
implementation
 
procedure Register;
begin
  RegisterComponents('Standard', [TsvdTOPpanel]);
end;
 
constructor TsvdTOPpanel.Create(AOwner: TComponent);
begin
 inherited Create(AOwner);
//настройка панели
  Left := 100;
  Top := 100;
  Height := 65;
  Width := 500;
  Constraints.MinWidth := 200;
  ParentColor := True;
  Font.Name := 'Tahoma';
  Font.Size := 12;
  Font.Style := [fsBold];
  Caption := '';
  BevelOuter := bvNone;
  Visible := True;
 
//фон панели
  FColor := TShape.Create(Self);
  with FColor do
    begin
      Parent := Self;
      Align := alClient;
      Brush.Color := clInfoBk
    end;
 
//полоса заголовка
  FTitle := TShape.Create(Self);
  with FTitle do
    begin
      Parent := Self;
      Top := 2;
      Left := 2;
      Height := 18;
      Width := (Self.Width - Top - 2);
      Brush.Color := clInactiveCaption;
    end;
 
//текст в верхнем левом углу
  FCaptionTitle := TLabel.Create(Self);
  with FCaptionTitle do
    begin
      Parent := Self;
      AutoSize := True;
      Top := 2;
      Left := 2;
      Height := 18;
      Width := (Self.Width - Top - 2);
      Transparent := True;
      Caption := '';
     // ParentFont := False;
      Color := clInactiveCaption;
    end;
 
// checkbox
  FCheckBox := TCheckBoxEx.Create(Self);
  with FCheckBox do
    begin
      Parent := Self;
      Left := 5;
      Top := FCaptionTitle.Height + 4;
      Width := (Self.Width - Top - 10);
      WordWrap := True;
      Caption := 'Text';
     // ParentFont := False;
      Color := FColor.Brush.Color;
    end;
end;
 
procedure TsvdTOPpanel.AutoHeight;
begin
  Self.Height := Self.Height + 1;
  Self.Height := Self.Height - 1;
end;
 
procedure TsvdTOPpanel.SetTextNum(Value: string);
begin
   FTextNum := Value ;
   FCaptionTitle.Caption := ' ' + FTextNum;
   AutoHeight
end;
 
procedure TsvdTOPpanel.SetTextCh(Value: string);
begin
   FTextCh := Value ;
   FCheckBox.Caption := FTextCh;
   AutoHeight
end;
 
procedure TsvdTOPpanel.Resize;
begin
  inherited Resize;
  FTitle.Width := Self.Width - FTitle.Left - 2;
  FTitle.Height := FCaptionTitle.Height;
  FCheckBox.Top := FCaptionTitle.Height + 4;
  FCheckBox.Width := Self.Width - FCheckBox.Left - 10;
  Self.Height := FCheckBox.Height + FCheckBox.Top + 2;
end;
 
end.

И ещё... как ПРАВИЛЬНО вытащить все свойства и события, используемых компонентов (checkbox и др) в инспектор объектов? Не пинайте сильно - никогда этого не делал.

Сообщение отредактировано: Mammoth - 22.02.06, 01:24

Цитата Mammoth @ 22.02.06, 01:00

И ещё... как ПРАВИЛЬНО вытащить все свойства и события, используемых компонентов (checkbox и др) в инспектор объектов?

Объявляешь дочерний компонент published-свойством основного компонента. Например:

type
  TMyComponent = class(TWinControl)
  ...
  published
    property CheckBox: TCheckBox read FCheckBox;
  end;
...
 
constructor TMyComponent.Create(AOwner: TComponent);
begin
  inherited;
 
  FCheckBox := TCheckBox.Create(Self);
  FCheckBox.Parent := Self;
  FCheckBox.SetSubComponent(True);
end;

Красным выделена ключевой фрагмент кода, осуществляющий собственно данную возможность.

Smike, а как убрать некоторые свойства (допустим из того же TCheckBox)

Цитата Mammoth @ 22.02.06, 05:57

а как убрать некоторые свойства (допустим из того же TCheckBox)

Много вопросов в одной теме... Это нужно писать своего наследника от TCustomCheckBox.

Цитата Mammoth @ 22.02.06, 01:00

а в этом коде могут быть проблемы?

На первый взгляд достаточно хорошо. Только ведь у нас нет реализации TCheckBoxEx ! Так что посмотри сам за поведением при изменениях размеров.
И еще совет: судя по коду внутри Resize, ты автоматически изменяешь ширины элеметов вложенных в панель. Попробуй использовать якоря - ведь их
для того и придумали чтобы дети "следили" за размерениями родителей. (Свойство .Anchors)

Цитата RuSA @ 22.02.06, 11:12

для того и придумали чтобы дети "следили" за размерениями родителей. (Свойство .Anchors)

Знаю, что для того, но оно не подходит. Именно из-за

Цитата RuSA @ 22.02.06, 11:12

реализации TCheckBoxEx !

Которого, собственно у Вас нет . Код немного переработал. Корявый, но работает. В дальнейшем доработаю. Сейчас время поджимает. Код выложу чуть-чуть позднее. Сейчас нет под рукой.

Вот что у меня получилось

unit svdTOPpanel;
 
interface
 
uses
  SysUtils, Classes, Controls, ExtCtrls, StdCtrls, Graphics, CheckBoxEx,
  Messages, Forms, Jpeg, Dialogs;
  
type
  TsvdTOPpanel = class(TPanel)
  private
    {components}
    FColor: TShape;
    FTitle: TShape;
    FCaptionTitle: TLabel;
    FCheckBox: TCheckBoxEx;
    FImPanel: TPanel;
    FImage: TImage;
    {Value}
    FTextNum: string;
    FTextCh: string;
    FFontSizeToCaptionText: byte;
    FFontSizeToCheckboxText: byte;
 
    {functions/procedures}
    procedure SetLoadFontSizeToCaptionText(Value: byte);
    procedure SetLoadFontSizeToCheckboxText(Value: byte);
 
    procedure SetTextNum(Value: string);
    procedure SetTextCh(Value: string);
    { Private declarations }
  protected
    { Protected declarations }
    procedure Resize; override; //изменение размера
  public
    { Public declarations }
 
  published
    { Published declarations }
    
    property CaptionText: string read FTextNum write SetTextNum;
    property CheckBoxText: string read FTextCh write SetTextCh;
    property CaptionFontSize: byte read FFontSizeToCaptionText write SetLoadFontSizeToCaptionText;
    property CheckboxFontSize: byte read FFontSizeToCheckboxText write SetLoadFontSizeToCheckboxText;
 
    //добавить свойства и события составляющих
    property SubCheckBoxEx: TCheckBoxEx read FCheckBox;
    property SubColor: TShape read FColor;
    property SubTitle: TShape read FTitle;
    property SubCaptionTitle: TLabel read FCaptionTitle;
    property SubImage: TImage read FImage;
    property SubImPanel: TPanel read FImPanel;
    //procedure CMTextChanged(var Message: TMessage); message CM_CHANGED;
    procedure AutoHeight;
    //конструктор
    constructor Create(AOwner: TComponent); override;
  end;
 
procedure Register;
 
implementation
 
procedure Register;
begin
  RegisterComponents('Standard', [TsvdTOPpanel]);
end;
 
constructor TsvdTOPpanel.Create(AOwner: TComponent);
begin
 inherited Create(AOwner);
//настройка панели
  Width := 200;
  Constraints.MinWidth := 100;
  ParentColor := True;
  ParentFont := False;
  Font.Name := 'Tahoma';
  Font.Size := 8;
  BevelOuter := bvNone;
  Visible := True;
  Caption := Name;
 
//фон панели
  FColor := TShape.Create(Self);
  with FColor do
    begin
      Parent := Self;
      Align := alClient;
      Brush.Color := clInfoBk;
      Pen.Color := clGray;
      Name := 'SubColor';
      SetSubComponent(True);
    end;
 
//полоса заголовка
  FTitle := TShape.Create(Self);
  with FTitle do
    begin
      Parent := Self;
      Top := FColor.Top;
      Left := FColor.Left;
      Height := 18;
      Width := (Self.Width - Left);
      Brush.Color := $00DF967A;
      Pen.Color := clGray;
      Name := 'SubTitle';
      SetSubComponent(True);
    end;
 
//текст в верхнем левом углу
  FCaptionTitle := TLabel.Create(Self);
  with FCaptionTitle do
    begin
      Parent := Self;
      Top := FColor.Top + 1;
      Left := FColor.Left + 4;
      Transparent := True;
      Font.Name :=  'Tahoma';
      Font.Size := 8;
      FFontSizeToCaptionText := 8;
      Font.Style := [fsBold];
      Font.Color := clCAptionText;
      Color := clInActiveCaption;
      Name := 'SubCaptionTitle';
      SetSubComponent(True);
      Caption := '';
    end;
 
//checkbox
  FCheckBox := TCheckBoxEx.Create(Self);
  with FCheckBox do
    begin
      Parent := Self;
      Left := 5;
      Top := FTitle.Height + {4}10;
      Width := (Self.Width - (Left * 2));
      WordWrap := True;
      Font.Name :=  'Tahoma';
      Font.Size := 8;
      FFontSizeToCheckboxText := 8;
      //ParentFont := False;
      Color := FColor.Brush.Color;
      Name := 'SubCheckBoxEx';
      SetSubComponent(True);
      Caption := '';
    end;
 
//imPanel
  FImPanel := TPanel.Create(Self);
  with FImPanel do
    begin
      Parent := Self;
      BevelInner := bvNone;
      BevelOuter := bvNone;
      Color := FColor.Brush.Color;
      Left := FCheckBox.Left + 18;
      Top := FCheckBox.Top;
      Width := Self.Width - Left - 18;
      AutoSize := False;
      Height := 5;//FCheckBox.Height;
      //ParentFont := False;
      Anchors := [akLeft,akTop,akRight,akBottom];
      Name := 'SubImPanel';
      Visible := False;
      SetSubComponent(True);
      Caption := '';
    end;
 
//image
  FImage := TImage.Create(Self);
  with FImage do
    begin
      Parent := FImPanel;
      Align := alClient;
      Visible := True;
      Name := 'SubImage';
      Center := True;
      Proportional := True;
      Transparent := True;
      SetSubComponent(True);
    end;
end;
 
procedure TsvdTOPpanel.AutoHeight;
begin
  Self.Height := Self.Height + 1;
  Self.Height := Self.Height - 1;
end;
 
procedure TsvdTOPpanel.SetTextNum(Value: string);
begin
   FTextNum := Value;
   FCaptionTitle.Caption := FTextNum;
   AutoHeight
end;
 
procedure TsvdTOPpanel.SetTextCh(Value: string);
begin
   FTextCh := Value ;
   FCheckBox.Caption := FTextCh;
   AutoHeight
end;
 
procedure TsvdTOPpanel.Resize;
begin
  inherited Resize;
  FCaptionTitle.Top := FColor.Top + 1;
  FCaptionTitle.Left := FColor.Left + 4;
  FTitle.Width := Self.Width - FTitle.Left;
  FTitle.Height := FCaptionTitle.Height + 3;
  FCheckBox.Top := FTitle.Height + 10;
  FCheckBox.Width := Self.Width - (FCheckBox.Left * 2);
  if FImPanel.Visible = True then
    begin
      FCheckBox.Caption := '';
      FImPanel.BringToFront;
      FImPanel.Top := FTitle.Height + 10;
      if (FCheckBox.Height + FCheckBox.Top + 10) < (FImage.Height + FCheckBox.Top + 10) then
        begin
          Self.Height := (FImage.Picture.Height+ 20 + FCheckBox.Top + 10);
          FImPanel.Height := Self.Height - FImPanel.Top - 10;
        end
      else
        begin
          Self.Height := (FCheckBox.Height + FCheckBox.Top + 10);
          FImPanel.Height := Self.Height - FImPanel.Top - 10;
        end;
      FImage.Center := True;
      Exit
    end;
  Self.Height := (FCheckBox.Height + FCheckBox.Top + 10);
end;
 
procedure TsvdTOPpanel.SetLoadFontSizeToCaptionText(Value: byte);
begin
  try
    if (Value >= 8) and (Value <= 30) then
      begin
        FFontSizeToCaptionText := Value;
        FCaptionTitle.Font.Size := FFontSizeToCaptionText;
      end
    else FFontSizeToCaptionText := Self.FCaptionTitle.Font.Size;
  except
    ShowMessage('Некорректное значение');
    FFontSizeToCaptionText := Self.FCaptionTitle.Font.Size;
  end;
  AutoHeight
end;
 
procedure TsvdTOPpanel.SetLoadFontSizeToCheckboxText(Value: byte);
begin
  try
    if (Value >= 8) and (Value <= 30) then
      begin
        FFontSizeToCheckboxText := Value;
        FCheckbox.Font.Size := FFontSizeToCheckboxText;
      end
    else FFontSizeToCheckboxText := Self.FCheckBox.Font.Size;
  except
    ShowMEssage('Некорректное значение');
    FFontSizeToCheckboxText := Self.FCheckBox.Font.Size;
  end;
  AutoHeight
end;
 
end.

Что можно (читать - надо) подправить?