Доброго времени суток.
Давно слежу за проектом Lazarus, но, в основном, по привычке, пишу на turbo-delphy. Его возможностей вполне хватает при создании нужных компонентов в runtime. НО - будущего марки "турбо" не вижу.
Сабж:
Есть несколько наработок, которые, в виде компонентов, хотел-бы реализовать в Лаз., для потомков (вдруг пригодится?), но не настолько разобрался на данный момент.
Один из - компонент, реализующий базовую функциональность файлового менеджера.
Если кто поможет - буду рад и опубликую код тут, если нет - либо разберусь сам (насколько позволит время), либо нет...
Компоненты и примеры
Модератор: Модераторы
Хочу реализовать свой компонент на основе TCustomPanel.
У меня два вопроса:
1. Как Caption переместить в левый-верхний угол?
2. Как добавить надпись в некотором месте Panel шрифтом, отличным от Caption?
P.S. Что делает Invalidate?
Добавлено спустя 2 часа 4 минуты 51 секунду:
Со вторым и P.S. вопросами разобрался.
Как вывести Caption по некоторым координатам? Например X = 3; Y = 3.
Добавлено спустя 22 минуты 6 секунд:
По первому вопросу, я так понимаю, - это несовсем просто. Тогда может можно как-то скрыть это свойство, чтоб оно ни в инспекторе объектов, ни на самом компоненте не было видно?
Добавлено спустя 24 минуты 20 секунд:
Все - со всем разобрался.
Вопросов пока больше нет.
У меня два вопроса:
1. Как Caption переместить в левый-верхний угол?
2. Как добавить надпись в некотором месте Panel шрифтом, отличным от Caption?
P.S. Что делает Invalidate?
Добавлено спустя 2 часа 4 минуты 51 секунду:
Со вторым и P.S. вопросами разобрался.
Как вывести Caption по некоторым координатам? Например X = 3; Y = 3.
Добавлено спустя 22 минуты 6 секунд:
По первому вопросу, я так понимаю, - это несовсем просто. Тогда может можно как-то скрыть это свойство, чтоб оно ни в инспекторе объектов, ни на самом компоненте не было видно?
Добавлено спустя 24 минуты 20 секунд:
Все - со всем разобрался.
Вопросов пока больше нет.
dunin
Так не пойдёт. Если анимашка просто крутится - это не значит, что прога не зависла, точнее, запрос не завис. Нужна синхронизация анимашки с выполнением запроса. А это уже сложнее - ведь запрос Ваш делается там, а анимашка тут.
Так не пойдёт. Если анимашка просто крутится - это не значит, что прога не зависла, точнее, запрос не завис. Нужна синхронизация анимашки с выполнением запроса. А это уже сложнее - ведь запрос Ваш делается там, а анимашка тут.
alexs писал(а):Сразуб написал
В принципе могу написать. Но все же один вопрос, хоть и не важный, есть.
В новом компоненте есть два новых поля TFont. При смене их свойств в "Инспекторе объектов" сам компонент никак не реагирует пока не подведешь курсор к форме, где он расположен. При чем замечено, что это происходит со всеми свойствами (вновь добавленными), которые являются некоторыми классами. Если новые свойства имеют тип string или integer, то все перерисовывается сразу после смены значения в "Инспекторе объектов".
Установку значения делаю так:
Код: Выделить всё
procedure TChoose.SetFontName(const AValue: TFont);
begin
if FFontName <> AValue then begin
FFontName.Assign(AValue);
Invalidate; {Repaint (Invalidate+Update); тоже не помог}
end;
end;У TFont есть свойство OnChange.
Mr.Smart писал(а):У TFont есть свойство OnChange.
Спасибо! А как быть с полями образованными от TPersistent? Или какой класс лучше использовать, чтоб хранить в нем простые типы?
Например:
Код: Выделить всё
TIndent = class(TPersistent)
private
FLeftComment: integer;
FLeftName: integer;
FTopComment: integer;
FTopName: integer;
public
constructor Create;
published
property TopName: integer read FTopName write FTopName default 3;
property TopComment: integer read FTopComment write FTopComment default 3;
property LeftName: integer read FLeftName write FLeftName default 3;
property LeftComment: integer read FLeftComment write FLeftComment default 3;
end; Ответ на вопрос: "Зачем использовать класс?"
- Чтоб в инспекторе объектов разворачивался список.
Добавьте с свой класс событие OnChange.
Код: Выделить всё
TIndent = class(TPersistent)
private
FLeftComment: integer;
...
procedure SetTopName(const aValue: Integer);
public
property OnChange: TNotifyEvent read fOnChange write fOnChange;
constructor Create;
published
property TopName: integer read FTopName write SetTopName default 3;
...
end;
....
procedure TIndent.SetTopName(const aValue: Integer);
begin
if aValue=FTopName then
Exit;
FTopName:=aValue;
if Assigned(fOnChange) then
fOnChange(self);
end;
Mr.Smart писал(а):Добавьте с свой класс событие OnChange.
Спасибо! Чет сам недогодался
Гугл выдает довольно много ссылок по этой теме
guranvir писал(а):Гугл выдает довольно много ссылок
Гугл гуляет лесом, когда нужно, что-то конктетно без рассусоливаний типа: "попробуй почитать там", "неужели не помогает?", "извиняюсь за оффтоп (перешедший в ТОП)"; и нужно срочно. Да и еслиб Гугл был Годсом, то зачем бы нужен был "freepascal.ru", на котором Вы, guranvir, вчера зарегистрировались?
Вот код компонента TFlag:
По умолчанию размер компонента выравнивается относительно Caption.
Теперь пишу другой компонент, в котором использую выше приведенный (TFlag). В перекрытой процедуре Paint беру высоту и ширину компонента TFlag:
Но они почемуто равны нулю. Хотя на новом компоненте TFlag отображается корректно и в высоту и в длинну.
Внимание вопрос!
Что не так я делаю?
Код: Выделить всё
unit Flag;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, LCLType;
type
TLocation = (lcLeft, lcRight, lcCenter);
{ TFlag }
TFlag = class(TCustomControl)
private
FAutoSize: Boolean;
FBorderSpacingChild: integer;
FCaption: string;
{ Private declarations }
FChecked: boolean;
FColorFlag: TColor;
FLocation: TLocation;
FTransparent: boolean;
procedure SetAutoSize(const AValue: Boolean);
procedure SetBorderSpacingChild(const AValue: integer);
procedure SetCaption(const AValue: string);
procedure SetChecked(const AValue: boolean);
procedure SetColorFlag(const AValue: TColor);
procedure SetLocation(const AValue: TLocation);
procedure SetTransparent(const AValue: boolean);
protected
{ Protected declarations }
procedure Paint; override;
procedure Change(Sender: TObject); virtual;
public
{ Public declarations }
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
published
{ Published declarations }
property Align;
property Location: TLocation read FLocation write SetLocation default lcLeft;
property AutoSize: Boolean read FAutoSize write SetAutoSize default true;
property BorderSpacingChild: integer read FBorderSpacingChild write SetBorderSpacingChild default 3;
property Caption: string read FCaption write SetCaption;
property Checked: boolean read FChecked write SetChecked default false;
property Color default clWhite;
property ColorFlag: TColor read FColorFlag write SetColorFlag default clBlack;
property Font;
property OnClick;
property ParentColor;
property ParentFont;
property Transparent: boolean read FTransparent write SetTransparent default true;
property Visible;
end;
procedure Register;
implementation
procedure Register;
begin
{$I flag_icon.lrs}
RegisterComponents('Standard',[TFlag]);
end;
{ TFlag }
procedure TFlag.SetChecked(const AValue: boolean);
begin
if FChecked <> AValue then begin
FChecked:= AValue;
Invalidate;
end;
end;
procedure TFlag.SetColorFlag(const AValue: TColor);
begin
if FColorFlag<>AValue then begin
FColorFlag:=AValue;
Invalidate;
end;
end;
procedure TFlag.SetLocation(const AValue: TLocation);
begin
if FLocation<>AValue then begin
FLocation:=AValue;
Invalidate;
end;
end;
procedure TFlag.SetTransparent(const AValue: boolean);
begin
if FTransparent<>AValue then begin
FTransparent:=AValue;
Invalidate;
end;
end;
procedure TFlag.Change(Sender: TObject);
begin
Invalidate;
end;
procedure TFlag.SetCaption(const AValue: String);
begin
if FCaption<>AValue then begin
FCaption:=AValue;
Invalidate;
end;
end;
procedure TFlag.SetAutoSize(const AValue: Boolean);
begin
if FAutoSize<>AValue then begin
FAutoSize:=AValue;
Invalidate;
end;
end;
procedure TFlag.SetBorderSpacingChild(const AValue: integer);
begin
if FBorderSpacingChild<>AValue then begin
FBorderSpacingChild:=AValue;
Invalidate;
end;
end;
procedure TFlag.Paint;
var
cfh, cfw: integer;
p: array [1..3] of TPoint;
begin
inherited Paint;
if FCaption = '' then FCaption:= Name;
cfh:= canvas.TextHeight(FCaption);
cfw:= canvas.TextWidth(FCaption)+3;
if FAutoSize then begin
Height:= cfh+(2*FBorderSpacingChild);
if FLocation = lcCenter then Width:= canvas.TextWidth(FCaption)+(2*FBorderSpacingChild)
else Width:= (3+cfh)+Canvas.TextWidth(FCaption)+(2*FBorderSpacingChild);
end;
Canvas.Brush.Color:= Color;
if FTransparent then Canvas.Brush.Style:= bsClear
else Canvas.Brush.Style:= bsSolid;
Canvas.Clear;
if FLocation = lcLeft then Canvas.TextOut(3+cfh+FBorderSpacingChild, FBorderSpacingChild, FCaption)
else Canvas.TextOut(FBorderSpacingChild, FBorderSpacingChild, FCaption);
Canvas.Pen.Color:= FColorFlag;
Canvas.Brush.Style:= bsSolid;
Canvas.Brush.Color:= FColorFlag;
if FChecked then begin
case FLocation of
lcLeft: begin
p[1].X:= cfh+FBorderSpacingChild; p[1].Y:= FBorderSpacingChild;
p[2].X:= p[1].X; p[2].Y:= p[1].X;
p[3].X:= FBorderSpacingChild; p[3].Y:= (cfh div 2)+FBorderSpacingChild;
Canvas.Polygon(p);
end;
lcRight: begin
p[1].X:= cfw+FBorderSpacingChild; p[1].Y:= FBorderSpacingChild;
p[2].X:= FBorderSpacingChild+cfh+cfw; p[2].Y:= FBorderSpacingChild+(cfh div 2);
p[3].X:= p[1].X; p[3].Y:= FBorderSpacingChild+cfh;
Canvas.Polygon(p);
end;
lcCenter: begin
Canvas.Brush.Style:= bsClear;
Canvas.Rectangle(0, 0, Width, Height);
end;
end;
end;
end;
constructor TFlag.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
FCaption := Name;
Canvas.Brush.Style:= bsClear;
ParentFont:= true;
font.Assign(DefaultLogFont);
Font.OnChange:= @Change;
FChecked:= false;
FBorderSpacingChild:= 3;
FTransparent:= true;
Color:= clWhite;
ColorFlag:= clBlack;
FAutoSize:= true;
end;
destructor TFlag.Destroy;
begin
inherited Destroy;
end;
end.По умолчанию размер компонента выравнивается относительно Caption.
Теперь пишу другой компонент, в котором использую выше приведенный (TFlag). В перекрытой процедуре Paint беру высоту и ширину компонента TFlag:
Код: Выделить всё
ch := controlFlag.Height;
cw := controlFlag.Width;Но они почемуто равны нулю. Хотя на новом компоненте TFlag отображается корректно и в высоту и в длинну.
Внимание вопрос!
Что не так я делаю?
Хм, странно выглядит то, что размеры флага устанавливаются в Paint. Если ch := controlFlag.Height; вызывается до того, как флаг перерисовался, то правильную высоту получить наверное не удастся. Я бы в таком случае попробовал изменить флаг так, чтобы высота и ширина были определены сразу, с момента создания компонента.
Odyssey писал(а):с момента создания компонента
А если изменится размер шрифта, то нужно опять же пересмотреть размер флага. Значит нужно это отслеживать в Paint. Другое дело, что может AutoSize я неправильно обрабатываю...