![]() |
| ||
|
|
Новости |
Поиск |
FAQ |
Статьи |
Книги |
Новости VCL
| | Форумы ЧАТ |
Орешник |
|
| |||
| |||
« предыдущая ветвь | форум | следующая ветвь »
Добавление published свойства
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.