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

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

Добавление published свойства


Страницы:   1 2 3 4 5 6

RASkov ©   (2006-09-10 05:27:00) 

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

TMyCompanent = class(TCompanent)
private
FCanvas: TCanvas;
....
published
property Canvas: TCanvas ....?????...
....
end;

Можно кусок примера как это делается. Т.е. если "кинуть" мой компанент на читую("голую") форму то в Инсп.Объектов у моего компанента в списке свойства Canvas должна быть Form1. Бросили на форму Image1 - и его в список. Ну и так всех у кого есть канва.


DimaBr   (2006-09-28 10:58:00) [61]

Нет, я думаю что RASkov хочет отрисовывать меню на контроле, а не POPUP.

> TFriendControl(FControl).PopupMenu := nil;
> TFriendControl(FControl).PopupMenu := FMainMenu

Жестоко, как мне кажется.


Юрий Зотов   (2006-09-28 10:41:00) [62]

Забыл - в AssignTo надо добавить присвоение ItemChecked и ItemEnabled.


Юрий Зотов   (2006-09-28 10:39:00) [63]

type
 TYzMenuManager = class;
 TYzMenuCollection = class;

 TYzMenuCollectionItem = class(TCollectionItem)
 private
   FItemCaption: string;
   FItemChecked: boolean;
   FItemEnabled: boolean;
   FItemMenu: TPopupMenu;
   FLeft: integer;
   FTop: integer;
   procedure SetItemCaption(const Value: string);
   procedure SetItemChecked(const Value: boolean);
   procedure SetItemEnabled(const Value: boolean);
   procedure SetItemMenu(const Value: TPopupMenu);
 protected
   procedure Notification(AComponent: TComponent; Operation: TOperation); dynamic;
   procedure AssignTo(Dest: TPersistent); override;
   function GetDisplayName: string; override;
   function GetManager: TYzMenuManager;
 public
   constructor Create(Collection: TCollection); override;
   procedure ShowMenu;
 published
   property ItemCaption: string read FItemCaption write SetItemCaption;
   property ItemChecked: boolean read FItemChecked write SetItemChecked default False;
   property ItemEnabled: boolean read FItemEnabled write SetItemEnabled default True;
   property ItemMenu: TPopupMenu read FItemMenu write SetItemMenu;
   property Left: integer read FLeft write FLeft default 0;
   property Top: integer read FTop write FTop default 0;
 end;

 TYzMenuCollection = class(TOwnedCollection)
 protected
   procedure Update(Item: TCollectionItem); override;
   procedure Notification(AComponent: TComponent; Operation: TOperation); dynamic;
 public
   function GetManager: TYzMenuManager;
   function GetMenuItem(Index: integer): TYzMenuCollectionItem;
 end;

 TYzMenuManager = class(TComponent)
 private
   FControl: TControl;
   FMenuCollection: TCollection;
   FMainMenu: TPopupMenu;
   procedure SetControl(const Value: TControl);
   procedure SetMenuCollection(const Value: TCollection);
   procedure MainMenuItemClick(Sender: TObject);
 protected
   procedure Notification(AComponent: TComponent; Operation: TOperation); override;
   procedure UpdateMainMenu;
   property MainMenu: TPopupMenu read FMainMenu;
 public
   constructor Create(AOwner: TComponent); override;
   destructor Destroy; override;
   function GetMenuCollection: TYzMenuCollection;
 published
   property Control: TControl read FControl write SetControl;
   property MenuCollection: TCollection read FMenuCollection write SetMenuCollection;
 end;

{ TYzMenuCollectionItem }

procedure TYzMenuCollectionItem.AssignTo(Dest: TPersistent);
begin
 if Dest is TYzMenuCollectionItem then
   with TYzMenuCollectionItem(Dest) do
   begin
     Collection.BeginUpdate;
     try
       ItemCaption := Self.ItemCaption;
       ItemMenu := Self.ItemMenu;
       Index := Self.Index;
       Left := Self.Left;
       Top := Self.Top
     finally
       Collection.EndUpdate
     end
   end
 else
   inherited
end;

constructor TYzMenuCollectionItem.Create(Collection: TCollection);
begin
 inherited;
 FItemEnabled := True
end;

function TYzMenuCollectionItem.GetDisplayName: string;
begin
 Result := FItemCaption
end;

function TYzMenuCollectionItem.GetManager: TYzMenuManager;
begin
 Result := TYzMenuCollection(Collection).GetManager
end;

procedure TYzMenuCollectionItem.Notification(AComponent: TComponent; Operation: TOperation);
begin
 if (Operation = opRemove) and (AComponent = FItemMenu) then
   FItemMenu := nil
end;

procedure TYzMenuCollectionItem.SetItemCaption(const Value: string);
begin
 if not AnsiSameStr(Value, FItemCaption) then
 begin
   FItemCaption := Value;
   Changed(False)
 end
end;

procedure TYzMenuCollectionItem.SetItemChecked(const Value: boolean);
begin
 if FItemChecked <> Value then
 begin
   FItemChecked := Value;
   Changed(False)
 end
end;

procedure TYzMenuCollectionItem.SetItemEnabled(const Value: boolean);
begin
 if FItemEnabled <> Value then
 begin
   FItemEnabled := Value;
   Changed(False)
 end
end;

procedure TYzMenuCollectionItem.SetItemMenu(const Value: TPopupMenu);
begin
 if FItemMenu <> Value then
 begin
   if FItemMenu <> nil then
     FItemMenu.RemoveFreeNotification(GetManager);
   FItemMenu := Value;
   if FItemMenu <> nil then
     FItemMenu.FreeNotification(GetManager)
 end
end;

procedure TYzMenuCollectionItem.ShowMenu;
var
 SavePopupComponent: TComponent;
 P: TPoint;
begin
 if (GetManager.Control <> nil) and (FItemMenu <> nil) then
 begin
   SavePopupComponent := FItemMenu.PopupComponent;
   FItemMenu.PopupComponent := GetManager.Control;
   try
     P := GetManager.Control.ClientToScreen(Point(Left, Top));
     FItemMenu.Popup(P.X, P.Y)
   finally
     FItemMenu.PopupComponent := SavePopupComponent
   end
 end
end;

{ TYzMenuCollection }

function TYzMenuCollection.GetManager: TYzMenuManager;
begin
 Result := TYzMenuManager(GetOwner)
end;

function TYzMenuCollection.GetMenuItem(Index: integer): TYzMenuCollectionItem;
begin
 Result := TYzMenuCollectionItem(Items[Index])
end;

procedure TYzMenuCollection.Notification(AComponent: TComponent; Operation: TOperation);
var
 i: integer;
begin
 for i := 0 to Count - 1 do
   GetMenuItem(i).Notification(AComponent, Operation)
end;

procedure TYzMenuCollection.Update(Item: TCollectionItem);
begin
 inherited;
 GetManager.UpdateMainMenu
end;

{ TYzMenuManager }

constructor TYzMenuManager.Create(AOwner: TComponent);
begin
 inherited;
 FMainMenu := TPopupMenu.Create(Self);
 FMenuCollection := TYzMenuCollection.Create(Self, TYzMenuCollectionItem)
end;

type
 TFriendControl = class(TControl);

destructor TYzMenuManager.Destroy;
begin
 if FControl <> nil then
   TFriendControl(FControl).PopupMenu := nil;
 FMenuCollection.Free;
 inherited
end;

function TYzMenuManager.GetMenuCollection: TYzMenuCollection;
begin
 Result := TYzMenuCollection(FMenuCollection)
end;

procedure TYzMenuManager.MainMenuItemClick(Sender: TObject);
begin
 GetMenuCollection.GetMenuItem(TMenuItem(Sender).MenuIndex).ShowMenu
end;

procedure TYzMenuManager.Notification(AComponent: TComponent; Operation: TOperation);
begin
 inherited;
 if (FMenuCollection <> nil) and not (csDestroying in ComponentState) then
 begin
   if (Operation = opRemove) and (AComponent = FControl) then
     FControl := nil;
   GetMenuCollection.Notification(AComponent, Operation)
 end
end;

procedure TYzMenuManager.SetControl(const Value: TControl);
begin
 if FControl <> Value then
 begin
   if FControl <> nil then
   begin
     TFriendControl(FControl).PopupMenu := nil;
     FControl.RemoveFreeNotification(Self);
   end;
   FControl := Value;
   if FControl <> nil then
   begin
     FControl.FreeNotification(Self);
     TFriendControl(FControl).PopupMenu := FMainMenu
   end
 end
end;

procedure TYzMenuManager.SetMenuCollection(const Value: TCollection);
begin
 FMenuCollection.Assign(Value)
end;

procedure TYzMenuManager.UpdateMainMenu;
var
 i: integer;
begin
 FMainMenu.Items.Clear;
 for i := 0 to FMenuCollection.Count - 1 do
   with GetMenuCollection.GetMenuItem(i) do
     FMainMenu.Items.Add(NewItem(ItemCaption, 0, ItemChecked, ItemEnabled, MainMenuItemClick, -1, ''))
end;

end.


DimaBr   (2006-09-28 08:53:00) [64]

В принципе, возвращаясь к старому, есть такой компонент, который рисует своё виденье мира на любом WinControl-е, естественно этот контрол уже теряет свою функциональность, это чудо называется TMediaPlayer.


DimaBr   (2006-09-28 08:44:00) [65]


> Что будет если убрать эти методы из моих классов?

Если убрать метод нотификации, то при удалении компонента на который будет ссылаться ваш контрол получим битую ссылку.


destructor TMyNewComp.Destroy;
begin
 FreeAndNil(fCompCollection);
 inherited;
end;

procedure TMyNewComp.Notification(AComponent: TComponent; Operation: TOperation);
var N: Integer;
begin
inherited;
if CompCollection <> nil then
  for N := 0 to CompCollection.Count -1 do
   TCompCollectionItem(CompCollection.Items[N]).Notification(AComponent,Operation);  
end;


Юрий Зотов   (2006-09-28 07:43:00) [66]

> берем ПаинтБокс кидаем на "голую" форму, кидаем туда пару, тройку моих
> компанентов и в их свойстве указываем один и тот же контрол ПаинтБокс,
> и вот они (мои компаненты) выводили бы каждый в определенных
> координатах свои пункты меню.

Практически то же самое делают плавающие тулбары. Чем не устраивают?


RASkov   (2006-09-28 02:13:00) [67]

Методами тыка апстенку :), сделал вывод, что виснет все из-за метода TMyNewComp.Notification, так же понял, что редактр свойства ненужен :)
Отсюда вопрос: для чего нужен Notification? Т.е. как его исправить? Я понял, что он вызывается при вставке/удаления "объектов классов"
и так же понял что ошибка при обращении к CompCollection в методе Notification. И почему, если сделать вот так,
procedure TMyNewComp.Notification(AComponent: TComponent; Operation: TOperation);
begin
 inherited Notification(AComponent, Operation);
 ShowMessage(AComponent.ClassName);
end;

то при добавлении/удалении либого (или многих, на всех не проверял:) компанента вылазит сообщение с именем его класса.
Что будет если убрать эти методы из моих классов?


RASkov   (2006-09-27 23:48:00) [68]

> [52] DimaBr   (27.09.06 15:26)

Спасибо большое.
К сожалению, код приведенный выше содержит ошибки, и я, никогда не писавший компаненты, попытался исправить их... Вроде бы, на мой (делитанский в этом плане) взгляд, исправил ошибки... даже скомпилировал... более того установил этот "чудо-новый мой" компанент
но при выборе его и попытки кинуть на форму.... Усе смерть всей IDE.
Значит не те ошибки исправил :) или более того ничего неисправил, а добавил новых... Что не так?И опять вопрос - нужно ли будет делать редактор для свойства CompColletion? (ну незнаю я как он делается)

Даже не смог заставить это заработать... пойду башкой апстену пится :)

Вот это чудо - смерть Delphi - называется :)
unit MyPicMenu;

interface

uses
 SysUtils, Classes, Controls;

type
 //TMyOldComp = class (TComponent);

 TCompCollectionItem = class(TCollectionItem)
  private
   fComp: TComponent; {TMyOldComp}
  public
   procedure Notification(AComponent: TComponent; Operation: TOperation);
  published
   property Comp: TComponent read fComp write fComp;
  end;

  TMyNewComp = class (TGraphicControl)
   fCompCollection: TCollection;
  protected
   procedure Paint; override;
  public
   constructor Create(AOwner: TComponent); override;
   destructor Destroy; override;
   procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  published
   property CompCollection: TCollection read fCompCollection write fCompCollection;
  end;

procedure Register;

implementation

procedure Register;
begin
 RegisterComponents('Stnd', [TMyNewComp]);
end;

{ TCompCollectionItem }

procedure TCompCollectionItem.Notification(AComponent: TComponent; Operation: TOperation);
begin
 if (Operation = opRemove) and (AComponent = Comp) then Comp := nil;
end;

{ TMyNewComp }

constructor TMyNewComp.Create(AOwner: TComponent);
begin
 inherited;
 fCompCollection := TCollection.Create(TCompCollectionItem);
end;

destructor TMyNewComp.Destroy;
begin

 inherited;
end;

procedure TMyNewComp.Notification(AComponent: TComponent; Operation: TOperation);
var N: Integer;
begin
 inherited;
 for N := 0 to CompCollection.Count -1 do
  TCompCollectionItem(CompCollection.Items[N]).Notification(AComponent,Operation);
end;

procedure TMyNewComp.Paint;
begin
 inherited;

end;

end.


Подозреваю, что у TCompCollectionItem нужно Create перекрыть, где создавать поле FComp... Но наверное собака в другом месте закопана.
PS DimaBr Огромное, тебе, спасибо за старание помочь


DimaBr   (2006-09-27 15:26:00) [69]

немного не так.

TCompCollectionItem = class(TCollectionItem)
  private
    fComp:  TMyOldComp;
  public
    procedure Notification(AComponent: TComponent; Operation: TOperation);
  published
     property Comp: TMyOldComp read fComp write fComp;
end;

TMyNewComp = class (TGraphicControl);
 fCompCollection: TCollection;
protected
procedure Paint; override;
public
  constructor Create(AOwner: TComponent);override;
  destructor Destroy;override;
  procedure Notification(AComponent: TComponent; Operation: TOperation); override;
published
property CompColletion: TCollections read fCompCollection write fCompCollection;
end;
......

constructor TMyNewComp.Create(AOwner: TComponent);
begin
 inherited;
 fCompCollection := TOwnedCollectio.Create(Self,TCompCollectionItem);
end;

procedure TMyNewComp.Notification(AComponent: TComponent; Operation: TOperation);
var i: integer;
begin
 inherited;
 for i := 0 to CompCollection.Count -1
   TCompCollectionItem(CompCollection.Items[i]).Notification(AComponent,Operation);
end;

procedure TMyNewComp.Notification(AComponent: TComponent; Operation: TOperation);
begin
 if (Operation = opRemove) and (AComponent = Comp) then Comp := nil;
end;

end;


RASkov   (2006-09-27 15:04:00) [70]

> [50] DimaBr   (27.09.06 08:33)

Спасибо. Мысль понял. Но чето нипойму как это будет выглядеть...
Т.е. как мне в контрол засунуть "много" дуругих. Здесь, наверное, для "нового" контрола нужно будет делать свойство множество для "старых" моих компанентов...
Т.е. примерно так что ли?

Type MyOldComp = class (TCompanent)
....
   public
    Draw(Cnv: TCanvas);
....
end;

TCompCollections = Set of TMyOldComp;

TMyNewComp = class (TGraphicControl);
 FPicture: TPicture;
 FBitMap: TBitmap;
 FCompCollections: TCompCollections;
 FCompCollectionCount: Integer;
....
protected
 Paint() override;
....
published
 property CompCollCount: Integer read FCompCollectionCount;
 property CompColletion: TCompCollections read GetCompColl write SetCompColl default [];
 property OnPaint; // А это лучше скрыть наверное, но добавить свойство типа "Фон": ТБитМап
......
end;


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


DimaBr   (2006-09-27 08:33:00) [71]

Ещё раз предлагаю, написать контрол, со свойством - коллекцией управляющих компонентов, который и будет рисовать (предоставлять канву для рисования). Код приблизительно таков

procedure TMyContriol.Paint;
var i: integer;
begin
 inherited;
 for i := 0 to CompCollection.Count -1 do
    CompCollection.Draw(Canvas);
end;


RASkov   (2006-09-26 23:03:00) [72]

> [48] GrayFace ©   (26.09.06 19:27)

Т.е. получается на OnPaint Controla подсовывать процедуру моего компанента

procedure TForm1.Form1Paint();
begin
 MyCompanent.DrawCnvs(Form1.Canvas);
end;


Если это имелось ввиду... то здесь наверное и смысла нет в компаненте...
Можно просто модуль сделать и таким вот способом рисовать. :)
PS: Я уже плохо сооброжаю чего хочу :)) Сенькс.


GrayFace   (2006-09-26 19:27:00) [73]

RASkov   (25.09.06 16:28) [39]
Вроде так что ли?

Ну да. Эта процедура DrawCnvs - в компоненте, а ее вызов при отрисовке какого-то контрола - уже дело пользователя. Как выводить - заботится компонент, куда - пользователь, тут у него и OnPaint, и все что нужно под рукой. Выпадающий список - в топку.

RASkov   (25.09.06 16:28) [39]
> RASkov   (22.09.06 16:23) [35]
> Где, как отловить/перекрыть момент заполнения списка поля
> CanvasControls
> write SetCanvasControls

Можно объяснить это - я так понимаю здесь можно ограничить выбор кнтролов а не отфильтровать... т.е. в списке будут все а выбрать будет возможно не все...


Да, я тут не понял вопрос.


DimaBr   (2006-09-26 16:55:00) [74]

1. Для ограничения самого списка придётся присать редактор свойства, там уж и будете выбирать какий компоненты подходят, а какие нет. Только в Run-Time этот редактор работать не будет, следовательно ничего не момешает динамически прицепить что угодно.

2. По всей видимости нужно писать как раз таки контрол который отображает, с коллекцией компонентов откуда брать данные, а не наоборот.


RASkov   (2006-09-26 16:44:00) [75]

Спасибо всем и отдельное DimaBr за ст арание помочь.
С русским как и с математикой... трабл:)


RASkov   (2006-09-26 16:40:00) [76]

Прошу прощения, но помоему:
procedure TMyComponent.SetCanvasControls(const Value: TCustomControl);
begin
if МНЕ ПОДХОДИТ ЭТОТ КОНТРОЛ then fCanvasControls := Value;
end;

Таким способом мы ограничиваем выбор свойства т.е. в инспекторе объектов в поле CanvasControls в выподающем списке будут все от TCustomControl но выбрать будет возможно исодя из if МНЕ ПОДХОДИТ ЭТОТ КОНТРОЛ then- это не совсем то что хотелось.
Хотелось, что бы в инсп. объектов в списке поля CanvasControls были только те контролы которые отвечают условию if МНЕ ПОДХОДИТ ЭТОТ КОНТРОЛ then


> Из пункта [39] лично я ничо не понял. Если можно, опишите
> подробрее (без троеточий) цель Вашего сочинения. Создаётся
> впечатление что Вас никто не понимает. По крайней мере,
> цель каждого контрола - корректно отображать свои данные.
>  Вы же предлагаете рисовать поверх него свои, тогда пропадает
> смысл в использовании этого контрола. Объясните на примерах
> похожих компонент.

Целью моего сочинения было сделать компанент который выводил бы графическое меню на канве выбранного контрола. Т.е. берем ПаинтБокс кидаем на "голую" форму, кидаем туда пару, тройку моих компанентов и в их свойстве указываем один и тот же контрол ПаинтБокс, и вот они (мои компаненты) выводили бы каждый в определенных координатах свои пункты меню. В итоге должно получится такое: контрол (жертва моих компанентов) рисует свою канву и после, поверх уже рисуют мои комп.

Эх... ладно если опять ничего не понятно, то тогда пора закрывать эту тему в связи с тем что нового здесь я уже ничего не узнаю, а как еще понятней объяснить не смогу.
По всей видимости надо свойство сделать жестко, типа TPaintBox и каким то образом заставить инсп. объектов сделать поле с выпадающим списком в котором будут перечислены все ПаинтБоксы на форме. Таким образом ограничить взаимодействие моих компанентов с контролами т.е. привязать их к ПаинтБоксам...
Спасибо всем и отдельное DimaBr за сторание помочь.


DimaBr   (2006-09-26 10:27:00) [77]


> Как здесь можно фильтр поставить т.е. "Етого добавить, а
> Етого нет"?


procedure TMyComponent.SetCanvasControls(const Value: TCustomControl);
begin
 if МНЕ ПОДХОДИТ ЭТОТ КОНТРОЛthen fCanvasControls := Value;
end;


Из пункта [39] лично я ничо не понял. Если можно, опишите подробрее (без троеточий) цель Вашего сочинения. Создаётся впечатление что Вас никто не понимает. По крайней мере, цель каждого контрола - корректно отображать свои данные. Вы же предлагаете рисовать поверх него свои, тогда пропадает смысл в использовании этого контрола. Объясните на примерах похожих компонент.


RASkov   (2006-09-25 21:04:00) [78]

ошибка, так должно:
property MenuWidth: Integer read GetMenuWidth write SetMenuWidth stored False;


RASkov   (2006-09-25 21:02:00) [79]

> [40] DimaBr   (25.09.06 16:53)

Это я уже попробовал...:(
Как здесь можно фильтр поставить т.е. "Етого добавить, а Етого нет"?

> Ваша процедура вывода изображения использует событие формы
> - решение не подходит, так как не у всех контролов есть
> OnPaint.

Это тут пару раз мне предложили сделать такую процедуру но я так и не понял что именно нужно и привел этот кусок кода... т.е. так я понял... короче ерунда какая то получается...

> Я так и не понял, зачем рисовать изображения на чужих контролах
> ?

Вроде подробно расписал в [39] вот неполное описание того что хотел сделать. За основу взял TPicClip из RxLib и хотел добавить некоторые свойства и методы:
Type
TOrientation = (orVert, orHoriz);

TPicMenu = class(TComponent)
 private
   FPicture: TPicture;
   FCountMenu: Integer;
   FBitmap: TBitmap;
   FOrientation: TOrientation;
   FCanvasControl: TGraphicControl;
.....
 published
  .......
   property MenuHeight: Integer read GetMenuHeight write SetMenuHeight stored False;
   property MenuWidth: Integer read GetWidth write SetWidth stored False;
   property CountMenu: Integer read FCountMenu write FCountMenu default 1;
   property Orientation: TOrientation read FOrientation write SetOrientation default orVert;
   property CanvasCtrl: TGraphicControl read FCanvasControl write SetCanvasControl;
 end;

Если чесно... то уже желание почти пропало этот компанент делать.
Многое, что понял... многое нет :( И хотелось бы поконкретней услышать про ту процедуру, что имели ввиду Ю.Зотов и GrayFace.
Спасибо всем кто хотел помочь.


DimaBr   (2006-09-25 16:58:00) [80]

Я так и не понял, зачем рисовать изображения на чужих контролах ?

Ваша процедура вывода изображения использует событие формы - решение не подходит, так как не у всех контролов есть OnPaint.


Страницы:   1 2 3 4 5 6

Наверх

Титульная страница Поиск, карта сайта Написать письмо