1

Тема: Допоможіть зрозуміти в чому помилка(Lazarus)

Всім добрий день! Намагаюсь зробити компонент на основі TLabel з можливістю відображення верхніх та нижніх індексів. Ось мій код

type
  TSuperSubLabel = class(TLabel)

  private

  protected
  procedure SuperSub;
  public

  published
    property AutoSize;
    property Caption;
    property Font;

  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Standard',[TSuperSubLabel]);
end;

procedure SuperSub(Canvas:TCanvas; const aRect:TRect; X, Y:integer ; text:String);
var i,xx:integer;
    subScript, superScript:boolean;
    DefFont:TFont;


begin
Canvas.FillRect(aRect);
DefFont:=TFont.Create;
DefFont.Assign(Canvas.Font);
with Canvas do begin
  xx:=X;

  for i:=1 to length(text) do
  begin
   if text[i-1] = '_' then subScript:=true
                      else subScript:=false;
   if text[i-1] = '^' then superScript:=true
                      else superScript:=false;


   if  (text[i] = '_')  and   (text[i] = '^')  then
   begin

      if ( subScript ) then
      begin
        Canvas.Font.Height:=Canvas.Font.Height*8 div 10;
        TextRect(Rect(xx,aRect.Top,xx+TextWidth(text[i]),aRect.Bottom),xx, Y+abs(8*Canvas.Font.Height-10*DefFont.Height) div 10, text[i]);
        inc(xx,TextWidth(text[i]));
      end;

      if ( not subScript) and ( not superScript ) then
      begin
        Canvas.Font:=DefFont;
        TextRect(Rect(xx,aRect.Top,xx+TextWidth(text[i]),aRect.Bottom),xx, Y, text[i]);
        inc(xx,TextWidth(text[i]));
      end;

      if ( superScript ) then
      begin
        Canvas.Font.Height:=Canvas.Font.Height*9 div 10;
        TextRect(Rect(xx,aRect.Top,xx+TextWidth(text[i]),aRect.Bottom),xx, Y-abs(8*Canvas.Font.Height-10*DefFont.Height) div 20, text[i]);
        inc(xx,TextWidth(text[i]));
      end;
      Canvas.Font:=DefFont;
   end;

  end;
end;
 DefFont.Free;
end;
end. 

Але видає помилку:"Error:Forward declaration not solved '' SuperSub'' "
Можливо ви знаєте посібник з цієї теми але не на freepascal.org?
Бо я тут прочитала статтю https://wiki.freepascal.org/How_To_Writ … _Component, але не знайшла потрібної інформації:(

2

Re: Допоможіть зрозуміти в чому помилка(Lazarus)

SuperSub є елементом класу TSuperSubLabel, відповідно, поза класом треба уточнювати, до якого класу вона належить:

 procedure TSuperSubLabel.SuperSub(...)
Подякували: polinakos1

3

Re: Допоможіть зрозуміти в чому помилка(Lazarus)

Наступним питанням мабуть буде "як зробити так, щоб процедура SuperSub викликалась автоматично". Відповідь дуже проста: треба створити власну версію процедури малювання для свого класу. Ось приклад: http://www.delphigroups.info/2/4c/512032.html Рядок "inherited Paint;" можна прибрати, якщо вам не потрібне стандартне малювання.
Взагалі Lazarus є відкритим клоном Delphi, тому дуже багато прикладів, які працюють в одному, працюватимуть і в іншому.

Подякували: polinakos, koala2

4

Re: Допоможіть зрозуміти в чому помилка(Lazarus)

koala написав:

SuperSub є елементом класу TSuperSubLabel, відповідно, поза класом треба уточнювати, до якого класу вона належить:

 procedure TSuperSubLabel.SuperSub(...)

Дякую за відповідь! Нажаль я так пробувала вже, але помилка не виправлялась :(

5

Re: Допоможіть зрозуміти в чому помилка(Lazarus)

Точно не виправилася? Чи з'явилася інша?

Подякували: polinakos1

6

Re: Допоможіть зрозуміти в чому помилка(Lazarus)

А, ну і аргументи треба вказувати і там, і там. У вас у класі проголошена процедура без аргументів.

Подякували: polinakos, leofun012

7

Re: Допоможіть зрозуміти в чому помилка(Lazarus)

koala написав:

А, ну і аргументи треба вказувати і там, і там. У вас у класі проголошена процедура без аргументів.

Дякую!Коли вказала аргументи вийшла ця помилка:

Error:Duplicate identifier "Canvas"
Hint: Identifier already defined in unit CONTROLS
Error: Duplicate identifier "Text"
Hint: Identifier already defined in unit CONTROLS

Потім я спробувала виправити це так:

Прихований текст
type
  TSuperSubLabel = class(TLabel)


  private

  protected
      procedure SuperSub(const aRect:TRect; X, Y:integer);
  public

  published
    property AutoSize;
    property Caption;
    property Font;


  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Standard',[TSuperSubLabel]);
end;

procedure TSuperSubLabel.SuperSub(const aRect:TRect; X, Y:integer);
var
    i,xx:integer;
    subScript, superScript:boolean;
    DefFont:TFont;

begin
Canvas.FillRect(aRect);
DefFont:=TFont.Create;
DefFont.Assign(Canvas.Font);
with Canvas do begin
  xx:=X;

  for i:=1 to length(Text) do
  begin
   if Text[i-1] = '_' then subScript:=true
                      else subScript:=false;
   if Text[i-1] = '^' then superScript:=true
                      else superScript:=false;


   if  (Text[i] = '_')  and   (Text[i] = '^')  then
   begin

      if ( subScript ) then
      begin
        Canvas.Font.Height:=Canvas.Font.Height*8 div 10;
        Canvas.TextRect(Rect(xx,aRect.Top,xx+TextWidth(text[i]),aRect.Bottom),xx, Y+abs(8*Canvas.Font.Height-10*DefFont.Height) div 10, text[i]);
        inc(xx,TextWidth(text[i]));
      end;

      if ( not subScript) and ( not superScript ) then
      begin
        Canvas.Font:=DefFont;
        Canvas.TextRect(Rect(xx,aRect.Top,xx+TextWidth(text[i]),aRect.Bottom),xx, Y, text[i]);
        inc(xx,TextWidth(text[i]));
      end;

      if ( superScript ) then
      begin
        Canvas.Font.Height:=Canvas.Font.Height*9 div 10;
        Canvas.TextRect(Rect(xx,aRect.Top,xx+TextWidth(text[i]),aRect.Bottom),xx, Y-abs(8*Canvas.Font.Height-10*DefFont.Height) div 20, text[i]);
        inc(xx,TextWidth(text[i]));
      end;
      Canvas.Font:=DefFont;
   end;

  end;
end;
 DefFont.Free;
end;
end.   

Верхні та нижні індекси не відображуються, зате немає помилок xD
Дякую ще раз за допомогу, далі вже буду переписувати код щоб все відображалося.

8

Re: Допоможіть зрозуміти в чому помилка(Lazarus)

Не відображається, бо вашу процедуру ніхто не викликає. Подивіться посилання, яке я вам вище закинув.

Подякували: polinakos1