| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Создание своего компонента-контейнера [D2005, XP]

pest ©   (2009-12-24 10:38:00) 

Всем привет. Создал визуальный компонент, состоящий из трех компонент. Вроде все норм, но не могу понять как в конструкторе грамотно прописать родителя этого компонента...тоесть как узнать куда именно кинули мой компонент и соответственно в конструкторе указать этот Parent. Компонент создаю в delphi 2009 на основе групбокса. в нем находится хидер и еще один групбокс. И еще кстати надо сделать так, чтобы внутренний групбокс был контейнером, тоесть если на него кидать другие компоненты (дизайнтайм), то они должны быть дочерними по отношение именно к внутреннему групбоксу, а не к главному. вот.

вот код:
unit cxDropBox;

interface

uses
 SysUtils, Classes, Controls, cxControls, cxContainer, cxEdit, cxGroupBox,
 cxHeader, cxCustomData, cxStyles, cxGraphics;

type
 TcxDropBox = class(TcxCustomGroupBox)
 private
   { Private declarations }
   Header: TcxHeader;
   ContentBox: TcxGroupBox;

   procedure HeaderSectionChangedSortOrder(Sender: TObject;
     const Section: TcxHeaderSection; const ASortOrder: TcxDataSortOrder);
   procedure fSetCaption(Value: TCaption);
   function fGetCaption: TCaption;
   procedure fSetState(Value: Boolean);
   function fGetState: Boolean;
 protected
   { Protected declarations }
 public
   { Public declarations }
   constructor Create(AOwner: TComponent); override;
 published
   { Published declarations }
   property Caption: TCaption read fGetCaption write fSetCaption;
   property State: Boolean read fGetState write fSetState;
 end;

procedure Register;

implementation

procedure Register;
begin
 RegisterComponents('PromoSoft', [TcxDropBox]);
end;

constructor TcxDropBox.Create(AOwner: TComponent);
begin
 inherited Create(AOwner);
 Parent := TWinControl(AOwner);
 Caption := '';
 Alignment := alCenterCenter;
 Style.BorderStyle := ebsNone;
 Height := 100;
 Align := alTop;

 ContentBox := TcxGroupBox.Create(Self);
 ContentBox.Parent := Self;
 ContentBox.Caption := '';
 ContentBox.Alignment := alCenterCenter;
 ContentBox.Align := alTop;
 ContentBox.Height := Height - 20;
 ContentBox.Style.Edges := [bLeft,bRight,bBottom];

 Header := TcxHeader.Create(Self);
 Header.Parent := Self;
 Header.Align := alTop;
 Header.Cursor := crHandPoint;
 Header.OnSectionChangedSortOrder := HeaderSectionChangedSortOrder;
 with Header.Sections.Add do
   begin
     AllowClick := true;
     AllowResize := false;
     AutoSize := true;
     MaxWidth := 10000;
     SortOrder := soAscending;
     Text := 'DropBox';
   end;
 with Header.Sections.Add do
   begin
     AllowResize := false;
     MinWidth := 1;
     Width := 1;
     Text := '';
   end;
end;

procedure TcxDropBox.HeaderSectionChangedSortOrder(Sender: TObject;
 const Section: TcxHeaderSection; const ASortOrder: TcxDataSortOrder);
begin
 if ASortOrder = soDescending then Height := Height - ContentBox.Height
 else Height := Height + ContentBox.Height;
 Header.Align := alTop;
end;

procedure TcxDropBox.fSetCaption(Value: TCaption);
begin
 if Assigned(Header) then
   Header.Sections.Items[0].Text := Value;
end;

function TcxDropBox.fgetCaption: TCaption;
begin
 if Assigned(Header) then
   Result := Header.Sections.Items[0].Text;
end;

procedure TcxDropBox.fSetState(Value: Boolean);
begin
 if not Assigned(Header) then exit;
 if Value then
   begin
     Header.Sections.Items[0].SortOrder := soAscending;
     HeaderSectionChangedSortOrder(Header, Header.Sections.Items[0], soAscending);
   end
 else
   begin
     Header.Sections.Items[0].SortOrder := soDescending;
     HeaderSectionChangedSortOrder(Header, Header.Sections.Items[0], soDescending);
   end;
end;

function TcxDropBox.fgetState: Boolean;
begin
 if not Assigned(Header) then exit;
 Result := (Header.Sections.Items[0].SortOrder = soAscending);
end;

end.

1. как правильно указывать Parent для создоваемого компонента?
2. как все, кидаемые на мой компонент, компоненты класть во внутренний групбокс?

заранее спасибо за совет

---

pest   (2009-12-25 14:35:00) [1]

unit cxDropBox;

interface

uses
 Classes, Controls, Messages, cxGroupBox, cxHeader, cxCustomData;

type
 TcxDropBox = class(TcxCustomGroupBox)
 private
   { Private declarations }
   Header: TcxHeader;
   fOpenedHeight: Integer;
   fAllCreated: Boolean;
   fClosed: Boolean;

   procedure WMSize(var Message: Tmessage); message WM_SIZE;

   procedure HeaderSectionChangedSortOrder(Sender: TObject;
     const Section: TcxHeaderSection; const ASortOrder: TcxDataSortOrder);
   procedure fSetCaption(Value: TCaption);
   function fGetCaption: TCaption;
   procedure fSetState(Value: Boolean);
 protected
   { Protected declarations }
   procedure CreateWnd; override;
 public
   { Public declarations }
 published
   { Published declarations }
   property OpenedHeight: Integer read fOpenedHeight write fOpenedHeight;
   property Caption: TCaption read fGetCaption write fSetCaption;
   property Closed: Boolean read fClosed write fSetState;
 end;

procedure Register;

implementation

procedure Register;
begin
 RegisterComponents('DropBox', [TcxDropBox]);
end;

procedure TcxDropBox.CreateWnd;
begin
 inherited;
 Caption := '';
 Alignment := alCenterCenter;
 Align := alTop;
 ControlStyle := ControlStyle + [csAcceptsControls];
 Margins.Bottom := 0;
 Margins.Left := 0;
 Margins.Right := 0;
 Margins.Top := 17;

 Header := TcxHeader.Create(Self);
 Header.Parent := Self;
 Header.Top := 0;
 Header.Left := 0;
 Header.Width := Width;
 Header.Cursor := crHandPoint;
 Header.OnSectionChangedSortOrder := HeaderSectionChangedSortOrder;
 with Header.Sections.Add do
   begin
     AllowClick := true;
     AllowResize := false;
     AutoSize := true;
     MaxWidth := 10000;
     if fClosed then SortOrder := soDescending else SortOrder := soAscending ;
     Text := 'DropBox';
   end;
 with Header.Sections.Add do
   begin
     AllowResize := false;
     MinWidth := 1;
     Width := 1;
     Text := '';
   end;
 if Height <> Header.Height then OpenedHeight := Height;
 fAllCreated := true;
end;

procedure TcxDropBox.WMSize(var Message: TMessage);
begin
 inherited;
 if not fAllCreated then exit;
 Header.Width := Width;
 if Height <> Header.Height then OpenedHeight := Height;
 if Closed then Height := Header.Height;
end;

procedure TcxDropBox.HeaderSectionChangedSortOrder(Sender: TObject;
 const Section: TcxHeaderSection; const ASortOrder: TcxDataSortOrder);
begin
 fClosed := (ASortOrder = soDescending);
 if fClosed then Height := Header.Height else Height := OpenedHeight;
end;

procedure TcxDropBox.fSetCaption(Value: TCaption);
begin
 if fAllCreated then Header.Sections.Items[0].Text := Value;
end;

function TcxDropBox.fgetCaption: TCaption;
begin
 if fAllCreated then Result := Header.Sections.Items[0].Text;
end;

procedure TcxDropBox.fSetState(Value: Boolean);
begin
 fClosed := Value;
 if not fAllCreated then exit;
 if Value then
   begin
     Header.Sections.Items[0].SortOrder := soDescending;
     HeaderSectionChangedSortOrder(Header, Header.Sections.Items[0], soDescending);
   end
 else
   begin
     Header.Sections.Items[0].SortOrder := soAscending;
     HeaderSectionChangedSortOrder(Header, Header.Sections.Items[0], soAscending);
   end;
end;

end.

Вопрос закрыт

---

Anatoly Podgoretsky   (2009-12-24 15:45:00) [2]

> может както перенесем ее в раздел компонентов?

Ты сам выбрал форум и он ничем не хуже других.

---

Ega23   (2009-12-24 15:23:00) [3]

> ув. модераторы, если тема не может быть решена в разделе
> для начинающих, может както перенесем ее в раздел компонентов?


В "Начинающих", как показывает практика, наибольший шанс получить быстрый ответ.
Так что я бы на твоём месте не дёргался... :)

---

pest   (2009-12-24 15:11:00) [4]

ув. модераторы, если тема не может быть решена в разделе для начинающих, может както перенесем ее в раздел компонентов?

---

pest   (2009-12-24 12:50:00) [5]

ок подожду еще советов) а тебе спасибо!

---

Ega23   (2009-12-24 12:47:00) [6]

Не знаю, я такими вещами не заморачивался обычно...

---

pest   (2009-12-24 12:37:00) [7]

ок. я заменил constructor Create(AOwner: TComponent); override;на procedure CreateWnd; override;, хотя и не совсем понял почему и зачем это делается. но первый вопрос вроде решился. компонент теперь можно кидать на другие компоненты, но как теперь решить второй вопрос? как заставить кидаемые внутрь компоненты получать родителя ContentBox, тоесть групбокса, находящегося внутри моего основного компонента?

---

Ega23   (2009-12-24 12:03:00) [8]

Работает и в ран-тайм, и в дизайн-тайм (если зарегистрировать).

---

Ega23   (2009-12-24 12:02:00) [9]

Короче, вот пример набросал.

unit uGrBoxControl;

interface

uses Windows, SysUtils, Controls, StdCtrls;

type

 TGrBoxControl = class (TGroupBox)
 protected

   procedure InitAll;
   procedure FinAll;
   procedure CreateWnd; override;
   procedure DestroyWnd; override;
 public

 end;

implementation

{ TGrBoxControl }

procedure TGrBoxControl.CreateWnd;
begin
 inherited;
 InitAll;
end;

procedure TGrBoxControl.DestroyWnd;
begin
 FinAll;
 inherited;
end;

procedure TGrBoxControl.FinAll;
var
 i : Integer;
begin
 for i := ControlCount - 1 downto 0 do
   Controls[i].Free;
end;

procedure TGrBoxControl.InitAll;
var
 grb : TGroupBox;
 ed : TEdit;
begin
 ed := TEdit.Create(Self);
 ed.Parent := Self;
 ed.Align := alBottom;
 ed.Text := 'Bootom Edit';

 grb := TGroupBox.Create(Self);
 grb.Parent := Self;
 grb.Align := alClient;
 grb.Caption := 'Inner GroupBox';

 ed := TEdit.Create(grb);
 ed.Parent := grb;
 ed.Align := alTop;
 ed.Text := 'GroupBox Edit';
end;

end.


---

pest   (2009-12-24 11:56:00) [10]

не понял. у меня есть
 TcxDropBox = class(TcxCustomGroupBox)
 private
   { Private declarations }
   Header: TcxHeader;
   ContentBox: TcxGroupBox;
я сделал так:
 public
   { Public declarations }
   constructor Create(AOwner: TComponent); override;
   procedure SetParent(AParent: TWinControl); override;
...
procedure TcxDropBox.SetParent(AParent: TWinControl);
begin
 inherited;
 if Assigned(AParent) then Parent := AParent;
end;

у меня ведь проблема с TcxDropBox, который ложится всегда на форму, куда бы его не кинул. как тогда мне сделать?

---

Ega23   (2009-12-24 11:42:00) [11]

так ты своим контролам её прописывай.

---

pest   (2009-12-24 11:34:00) [12]

тоесть так. но все равно выключается
procedure TcxDropBox.SetParent(AParent: TWinControl);
begin
Parent := AParent;
end;

---

pest   (2009-12-24 11:33:00) [13]

дописал:
procedure TcxDropBox.SetParent(AParent: TWinControl);
begin
 Parent := TWinControl(AParent);
end;
делфи моментально терминируется когда кидаю компонент на форму

---

Ega23   (2009-12-24 11:07:00) [14]

procedure SetParent(AParent: TWinControl); override;

---

Наверх