Компоненты и примеры

[Logos]

Доброго времени суток.

Давно слежу за проектом Lazarus, но, в основном, по привычке, пишу на turbo-delphy. Его возможностей вполне хватает при создании нужных компонентов в runtime. НО - будущего марки "турбо" не вижу.

Сабж:

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

Один из - компонент, реализующий базовую функциональность файлового менеджера.

Если кто поможет - буду рад и опубликую код тут, если нет - либо разберусь сам (насколько позволит время), либо нет...

[VirtUX]

Хочу реализовать свой компонент на основе TCustomPanel.
У меня два вопроса:
1. Как Caption переместить в левый-верхний угол?
2. Как добавить надпись в некотором месте Panel шрифтом, отличным от Caption?
P.S. Что делает Invalidate?

Добавлено спустя 2 часа 4 минуты 51 секунду:
Со вторым и P.S. вопросами разобрался.
Как вывести Caption по некоторым координатам? Например X = 3; Y = 3.

Добавлено спустя 22 минуты 6 секунд:
По первому вопросу, я так понимаю, - это несовсем просто. Тогда может можно как-то скрыть это свойство, чтоб оно ни в инспекторе объектов, ни на самом компоненте не было видно?

Добавлено спустя 24 минуты 20 секунд:
Все - со всем разобрался.
Вопросов пока больше нет.

[alexs]

VirtUX
Приятно послушать уменого человека
Сразуб написал для начинающих - как сделал. Люди тебе потом спасибо скажут.

[Vadim]

dunin
Так не пойдёт. Если анимашка просто крутится - это не значит, что прога не зависла, точнее, запрос не завис. Нужна синхронизация анимашки с выполнением запроса. А это уже сложнее - ведь запрос Ваш делается там, а анимашка тут.

[VirtUX]

Сразуб написал

В принципе могу написать. Но все же один вопрос, хоть и не важный, есть.
В новом компоненте есть два новых поля TFont. При смене их свойств в "Инспекторе объектов" сам компонент никак не реагирует пока не подведешь курсор к форме, где он расположен. При чем замечено, что это происходит со всеми свойствами (вновь добавленными), которые являются некоторыми классами. Если новые свойства имеют тип string или integer, то все перерисовывается сразу после смены значения в "Инспекторе объектов".
Установку значения делаю так:

Код: Выделить всё

procedure TChoose.SetFontName(const AValue: TFont);
begin
  if FFontName <> AValue then begin
    FFontName.Assign(AValue);
    Invalidate; {Repaint (Invalidate+Update); тоже не помог}
  end;
end;

[Mr.Smart]

У TFont есть свойство OnChange.

[VirtUX]

У 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;                 

Ответ на вопрос: "Зачем использовать класс?"
- Чтоб в инспекторе объектов разворачивался список.

[Mr.Smart]

Добавьте с свой класс событие 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;


[VirtUX]

Добавьте с свой класс событие OnChange.

Спасибо! Чет сам недогодался

[guranvir]

Гугл выдает довольно много ссылок по этой теме

[VirtUX]

Гугл выдает довольно много ссылок

Гугл гуляет лесом, когда нужно, что-то конктетно без рассусоливаний типа: "попробуй почитать там", "неужели не помогает?", "извиняюсь за оффтоп (перешедший в ТОП)"; и нужно срочно. Да и еслиб Гугл был Годсом, то зачем бы нужен был "freepascal.ru", на котором Вы, guranvir, вчера зарегистрировались?

[VirtUX]

Вот код компонента 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 отображается корректно и в высоту и в длинну.
Внимание вопрос!
Что не так я делаю?

[Odyssey]

Хм, странно выглядит то, что размеры флага устанавливаются в Paint. Если ch := controlFlag.Height; вызывается до того, как флаг перерисовался, то правильную высоту получить наверное не удастся. Я бы в таком случае попробовал изменить флаг так, чтобы высота и ширина были определены сразу, с момента создания компонента.

[VirtUX]

с момента создания компонента

А если изменится размер шрифта, то нужно опять же пересмотреть размер флага. Значит нужно это отслеживать в Paint. Другое дело, что может AutoSize я неправильно обрабатываю...

[alexs]

С автосайзом - целая песня!
Посмотри в RxFPC RxLockupDBComboBox - может поймёшь... если нет - попытаюсь объяснить насколько сам понял.