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

Вопросы программирования и использования среды Lazarus.

Модератор: Модераторы

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

Сообщение Logos » 13.06.2010 05:32:07

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

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

Сабж:

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

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

Если кто поможет - буду рад и опубликую код тут, если нет - либо разберусь сам (насколько позволит время), либо нет...
Logos
новенький
 
Сообщения: 37
Зарегистрирован: 25.03.2006 22:33:11

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

Сообщение VirtUX » 19.07.2010 17:27:25

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

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

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

Добавлено спустя 24 минуты 20 секунд:
Все - со всем разобрался.
Вопросов пока больше нет.
Аватара пользователя
VirtUX
энтузиаст
 
Сообщения: 869
Зарегистрирован: 05.02.2008 10:52:19
Откуда: Крым, Алушта

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

Сообщение alexs » 20.07.2010 20:10:19

VirtUX
Приятно послушать уменого человека :-)
Сразуб написал для начинающих - как сделал. Люди тебе потом спасибо скажут.
Аватара пользователя
alexs
долгожитель
 
Сообщения: 3943
Зарегистрирован: 15.05.2005 23:17:07
Откуда: г.Ставрополь

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

Сообщение Vadim » 21.07.2010 05:11:42

dunin
Так не пойдёт. Если анимашка просто крутится - это не значит, что прога не зависла, точнее, запрос не завис. Нужна синхронизация анимашки с выполнением запроса. А это уже сложнее - ведь запрос Ваш делается там, а анимашка тут. :)
Vadim
долгожитель
 
Сообщения: 3918
Зарегистрирован: 05.10.2006 08:52:59
Откуда: Красноярск

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

Сообщение VirtUX » 21.07.2010 12:25:59

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;
Аватара пользователя
VirtUX
энтузиаст
 
Сообщения: 869
Зарегистрирован: 05.02.2008 10:52:19
Откуда: Крым, Алушта

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

Сообщение Mr.Smart » 21.07.2010 12:43:11

У TFont есть свойство OnChange.
Mr.Smart
долгожитель
 
Сообщения: 1797
Зарегистрирован: 29.03.2008 01:01:11
Откуда: из леса!

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

Сообщение VirtUX » 21.07.2010 13:15:40

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;                 

Ответ на вопрос: "Зачем использовать класс?"
- Чтоб в инспекторе объектов разворачивался список.
Аватара пользователя
VirtUX
энтузиаст
 
Сообщения: 869
Зарегистрирован: 05.02.2008 10:52:19
Откуда: Крым, Алушта

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

Сообщение Mr.Smart » 21.07.2010 13:33:37

Добавьте с свой класс событие 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
долгожитель
 
Сообщения: 1797
Зарегистрирован: 29.03.2008 01:01:11
Откуда: из леса!

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

Сообщение VirtUX » 21.07.2010 15:52:59

Mr.Smart писал(а):Добавьте с свой класс событие OnChange.

Спасибо! Чет сам недогодался :oops:
Аватара пользователя
VirtUX
энтузиаст
 
Сообщения: 869
Зарегистрирован: 05.02.2008 10:52:19
Откуда: Крым, Алушта

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

Сообщение guranvir » 25.07.2010 12:45:09

Гугл выдает довольно много ссылок по этой теме
guranvir
незнакомец
 
Сообщения: 2
Зарегистрирован: 25.07.2010 11:14:59

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

Сообщение VirtUX » 26.07.2010 11:24:21

guranvir писал(а):Гугл выдает довольно много ссылок

Гугл гуляет лесом, когда нужно, что-то конктетно без рассусоливаний типа: "попробуй почитать там", "неужели не помогает?", "извиняюсь за оффтоп (перешедший в ТОП)"; и нужно срочно. Да и еслиб Гугл был Годсом, то зачем бы нужен был "freepascal.ru", на котором Вы, guranvir, вчера зарегистрировались?
Аватара пользователя
VirtUX
энтузиаст
 
Сообщения: 869
Зарегистрирован: 05.02.2008 10:52:19
Откуда: Крым, Алушта

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

Сообщение VirtUX » 30.07.2010 11:08:34

Вот код компонента 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 отображается корректно и в высоту и в длинну.
Внимание вопрос!
Что не так я делаю?
Аватара пользователя
VirtUX
энтузиаст
 
Сообщения: 869
Зарегистрирован: 05.02.2008 10:52:19
Откуда: Крым, Алушта

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

Сообщение Odyssey » 30.07.2010 11:35:18

Хм, странно выглядит то, что размеры флага устанавливаются в Paint. Если ch := controlFlag.Height; вызывается до того, как флаг перерисовался, то правильную высоту получить наверное не удастся. Я бы в таком случае попробовал изменить флаг так, чтобы высота и ширина были определены сразу, с момента создания компонента.
Odyssey
энтузиаст
 
Сообщения: 581
Зарегистрирован: 29.11.2007 17:32:24

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

Сообщение VirtUX » 30.07.2010 11:38:44

Odyssey писал(а):с момента создания компонента

А если изменится размер шрифта, то нужно опять же пересмотреть размер флага. Значит нужно это отслеживать в Paint. Другое дело, что может AutoSize я неправильно обрабатываю...
Аватара пользователя
VirtUX
энтузиаст
 
Сообщения: 869
Зарегистрирован: 05.02.2008 10:52:19
Откуда: Крым, Алушта

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

Сообщение alexs » 30.07.2010 20:29:00

С автосайзом - целая песня!
Посмотри в RxFPC RxLockupDBComboBox - может поймёшь... если нет - попытаюсь объяснить насколько сам понял.
Аватара пользователя
alexs
долгожитель
 
Сообщения: 3943
Зарегистрирован: 15.05.2005 23:17:07
Откуда: г.Ставрополь

Пред.След.

Вернуться в Lazarus

Кто сейчас на конференции

Сейчас этот форум просматривают: Bing [Bot] и гости: 27

Рейтинг@Mail.ru