|
Вопрос # 5 079/ вопрос открыт / |
|
Добрый день, прошу помощи по созданию компонента.
Необходим компонент Shape, а над ним Label. И чтобы впоследствии эта конструкция при перемещении Shape по форме двигалась синхронно. Переделал код из LabelEdit (просто заменил Edit на Shape), с LabelEdit перетаскивания работают отлично.
В моем компоненте при установке компонента LabelShape на форме появляется и Shape и Label, но отдельно (т.е. Label в левом верхнем углу), и при перемещении Shape не двигается Label. В чем ошибка ?
Заранее спасибо.
Приложение: Переключить в обычный режим- unit Lbshape;
-
- interface
-
- uses
- SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
- Forms, Dialogs, StdCtrls, ExtCtrls;
-
- type
- TLabelShape = class(TShape)
- private
- FLabel: TLabel;
- procedure WMMove(var Msg: TWMMove); message WM_MOVE;
- protected
- procedure SetParent(Value: TWinControl); override;
- function GetLabelCaption: string; virtual;
- procedure SetLabelCaption(const Value: string); virtual;
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- published
- property LabelCaption: string read GetLabelCaption write
- SetLabelCaption;
-
- end;
-
- procedure Register;
-
- implementation
-
- constructor TLabelShape.Create(AOwner: TComponent);
-
- begin
- inherited Create(AOwner);
-
-
- FLabel := TLabel.Create(nil);
- FLabel.Caption := 'Edit label';
- end;
-
- procedure TLabelShape.SetParent(Value: TWinControl);
-
- begin
-
- if (Owner = nil) or not (csDestroying in Owner.ComponentState) then
- FLabel.Parent := Value;
- inherited SetParent(Value);
- end;
-
- destructor TLabelShape.Destroy;
-
- begin
- if (FLabel <> nil) and (FLabel.Parent = nil) then
- FLabel.Free;
- inherited Destroy;
- end;
-
- function TLabelShape.GetLabelCaption: string;
-
- begin
- Result := FLabel.Caption;
- end;
-
- procedure TLabelShape.SetLabelCaption(const Value: string);
-
- begin
- FLabel.Caption := Value;
- end;
-
- procedure TLabelShape.WMMove(var Msg: TWMMove);
-
- begin
- inherited;
-
-
- if FLabel <> nil then
- with FLabel do
- SetBounds(Msg.XPos, Msg.YPos - Height, Width, Height);
- end;
-
- procedure Register;
- begin
- RegisterComponents('MyComponents', [TLabelShape]);
- end;
-
- initialization
-
-
- RegisterClass(TLabel);
- end.
-
 |
Вопрос задал: Snitus (статус: Посетитель)
Вопрос отправлен: 10 марта 2011, 20:42
Состояние вопроса: открыт, ответов: 1.
|
Ответ #1. Отвечает эксперт: min@y™
Ну, вроде набросал я тебе компонентик. Прицепляю к ответу вместе с программой тестирования.
Если чо не так - доработай напильником сам.
Ахтунг! Отлаживал в run-time, в палитру НЕ СТАВИЛ!
К ответу прикреплён файл. Загрузить » (срок хранения: 60 дней с момента отправки ответа)
 |
Ответ отправил: min@y™ (статус: Доктор наук)
Время отправки: 11 марта 2011, 09:55
|
Мини-форум вопроса
Всего сообщений: 5; последнее сообщение — 12 марта 2011, 09:09; участников в обсуждении: 2.
|
|
min@y™ (статус: Доктор наук), 10 марта 2011, 20:52 [#1]:
Не нужен тебе Label на TShape. Если нужна надпись на TShape, напиши его наследник, в котором перекрой (override) метод Paint и рисуй нужную надпись. Можно (нужно) добавить такие свойства, как Caption, Font, Alignment, Layout и т.д.
Сам справишься или помочь?
Делаю лабы и курсачи по Delphi и Turbo Pascal. За ПИВО! Пишите в личку, а лучше в аську. А ещё лучше - звоните в скайп!
|
|
|
Snitus (статус: Посетитель), 10 марта 2011, 22:20 [#2]:
От помощи не откажусь. В написании компонент совсем слабоват.
|
|
|
min@y™ (статус: Доктор наук), 11 марта 2011, 09:07 [#3]:
Цитата (Snitus):
От помощи не откажусь. В написании компонент совсем слабоват.
Ну чо, я пришёл на работу и сел писать компонент.
Самому интересно.
Делаю лабы и курсачи по Delphi и Turbo Pascal. За ПИВО! Пишите в личку, а лучше в аську. А ещё лучше - звоните в скайп!
|
|
|
Snitus (статус: Посетитель), 11 марта 2011, 20:50 [#4]:
Спасибо ! Первое впечатление очень хорошее.
Последовав вашим вчерашним советам сам с утра на работе создал компонент, что то даже получилось. Ну а с помощью вашего кода создам то, что нужно.
|
|
|
min@y™ (статус: Доктор наук), 12 марта 2011, 09:09 [#5]:
Цитата (Snitus):
Спасибо !
И это всё? Знал бы - даже не начинал бы писать.
Делаю лабы и курсачи по Delphi и Turbo Pascal. За ПИВО! Пишите в личку, а лучше в аську. А ещё лучше - звоните в скайп!
|
Чтобы оставлять сообщения в мини-форумах, Вы должны авторизироваться на сайте.
|
