Wlasny komponent instalacja

nie wiem o co chodzi a w Delphi pisałem dawno temu, ale jak masz stack overflow to pewnie masz wieczną pętlę gdzieś w wywołaniach funkcji (jedna funkcja wywołuje drugą, potem trzecią, trzecia znowu pierwszą i stos się odkłada aż się przepełni - to jedno z możliwych wytłumaczeń ). Może spróbuj to zdebugować step into / step over i zobaczyć co się wykonuje?

Udalo mi sie ustalic, ze zrodlo komponentu jest straszne ;) Doszedlem do momentu, ze Lazarus sie uruchamia i moge polozyc komponent na formie ale potem dzieja sie cuda ;) Popracuje nad tym dalej i zobaczymy co wymysle:)

Robisz ten kod bardzo źle i nieczytelnie, używając złych prefiksów elementów - dla zmiennych lokalnych używasz A, czyli prefiksu dla argumentów, a dla pól nie używasz w ogóle, choć powinieneś użyć prefiksu F; Bajzel się porobił, nazwy ponakładały, wstyd... :]

destructor TChessButton.Destroy;
begin
  inherited;
  ImgEnter.Free;
  ImgLeave.Free;
end;

Inherited w destruktorze wołaj na samym końcu;

procedure TChessButton.Paint;
var
 img:TImage;
 aRect:TRect;
begin
 inherited Paint;

To jest kupa straszna - nie rób tak, bo prosisz się o rekurencję, a w efekcie stack overflow; Malowanie komponentu zdefiniuj w całości w swojej metodzie i nie wołaj metody z klasy bazowej; To i tak nie ma sensu - najpierw wewnętrzna metoda Paint coś namaluje, a Ty później to zamalowujesz;

procedure TChessButton.CMMouseEnter(var Msg : TMessage);
begin
  if Assigned(FOnMouseEnter) then OnMouseEnter(Self);
  Mouse:=true;
end;
 
procedure TChessButton.CmMouseLeave(var Msg : TMessage);
begin
  if Assigned(FOnMouseLeave) then OnMouseLeave(Self);
  Mouse:=false;
end;

Wywołuj zdarzenia FOnMouseEnter i FOnMouseLeave, jak już coś; Zresztą, klasa TSpeedButton posiada już zdefiniowane te zdarzenia, więc robi się potworny misz-masz... Powinieneś najpierw sprawdzić, czy dana bazowa klasa posiada jakieś zdarzenie, zanim je dodasz do swojej klasy;

Przy okazji - jeżeli klasa bazowa posiada interesujące Cię zdarzenie to aby było widoczne w oknie Inspektora Obiektów w przypadku klasy końcowej (dziedziczącej), wystarczy napisać słówko Property i podać nazwę zdarzenia/właściwości, np.:

TChessButton = class(TSpeedButton)
{..}
published
  // uwidocznienie właściwości zdefiniowanych w klasie bazowej
  property Align;
  property Glyph;
published
  // uwidocznienie zdarzeń zdefiniowanych w klasie bazowej
  property OnMouseEnter;
  property OnMouseLeave;
end;

A jeśli Twoje zdarzenie ma być wywoływane kiedy indziej to nazwij je inaczej, aby identyfikatory nie nakładały się; Poza tym przyjęło się, że jeśli własny komponent ma dziedziczyć z innego, to powinien dziedziczyć z klasy o prefiksie TCustom, czyli w Twoim przypadku z klasy TCustomSpeedButton;

I tak jak pokazałem wyżej - to co jest już zaimplementowane w klasie bazowej, podbijasz za pomocą podanej wyżej konstrukcji (jak nie podbijesz to nie będzie widoczne w okienku właściwości, ale z poziomu kodu nadal dostępne - usunąć całkowicie nie da się); A to czego nie ma, oprogramowujesz po swojemu, według potrzeb.

Ok, udało mi się stworzyć działający komponent! O tyle ułatwi mi to sprawę, że nie będę musiał 'klepać formatek' pracując nad aplikacją ;)

Zdaję sobie sprawę z niedoskonałości kodu, zmienne polish-english, wykorzystanie TImage - ponoć mało oszczędne, no i wykorzystanie 2 zmienny gdzie w jednej przekazuje info o tym czy obrazy zostały załadowane (Fok) a w drugiej czy kursor aktualnie znajduje się nad buttonem czy nie (FMouse).
Co do pierwszej to nie wiem jak można to zrobić lepiej, co do drugiej to na pewno jest bardziej elegancki sposób na przekazanie argumentu do Paint.

Dla mnie satysfakcjonujący jest już fakt, że działa ;)

Mimo wszystko proszę o opinie.

unit ChessButton;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, Buttons, Windows, extctrls;

type
  TChessButton = class(TSpeedButton)
  private
    FOnFMouseEnter, FOnFMouseLeave : TNotifyEvent;

    Fok:integer;
    FFMouse:boolean;

    FObrazEnter,FObrazLeave:TImage;

    FImgEnter,FImgLeave:string;

    procedure CMFMouseEnter(var Message: TMessage); message CM_FMouseENTER;
    procedure CMFMouseLeave(var Message: TMessage); message CM_FMouseLEAVE;

  protected
    procedure SetImg;
    procedure Paint; override;
  public
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
  published
    property ImageEnter : String read FImgEnter write FImgEnter;
    property ImageLeave : String read FImgLeave write FImgLeave;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Additional',[TChessButton]);
end;

constructor TChessButton.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);
  Font.Color:=clWhite;
  Fok:=0;
  SetImg;
end;

destructor TChessButton.Destroy;
begin
  FObrazEnter.Free;
  FObrazLeave.Free;
  inherited;
end;

procedure TChessButton.Paint;
var
 aRect:TRect;
begin
  SetImg;
  if ok<>1 then Exit;

  aRect.Top:=0;
  aRect.Left:=0;
  aRect.Right:=Width;
  aRect.Bottom:=Height;


  if FMouse then begin Canvas.StretchDraw(aRect, FObrazEnter.Picture.Bitmap); end;
  if not FMouse then begin Canvas.StretchDraw(aRect, FObrazLeave.Picture.Bitmap); end;

     Canvas.Pen.Color:=clBlack;

     Canvas.MoveTo(0, 0);
     Canvas.LineTo(0, Height);

     Canvas.MoveTo(0, Height-1);
     Canvas.LineTo(Width, Height-1);

     Canvas.MoveTo(Width-1,height);
     Canvas.LineTo(Width-1,0);

     Canvas.MoveTo(Width,0);
     Canvas.LineTo(0,0);

     Canvas.Brush.Style := bsClear;

     SetTextAlign( Canvas.handle, TA_CENTER );
     Canvas.TextOut((Round(Width/2)), aRect.Top + 7, Caption);
     SetTextAlign( Canvas.handle, TA_LEFT );
     Font.Style := [];
end;

procedure TChessButton.SetImg;
begin
  if Fok=1 then Exit;

   if (FImgEnter<>'') and (FImgLeave<>'') then
  begin
    FObrazEnter:=TImage.Create(Self);
    FObrazEnter.Picture.LoadFromFile(FImgEnter);

    FObrazLeave:=TImage.Create(Self);
    FObrazLeave.Picture.LoadFromFile(FImgLeave);

    Fok:=1;
    FMouse:=false;
  end;

end;

procedure TChessButton.CMFMouseEnter(var Message: TMessage);
begin
  FMouse:=true;
  Paint;
end;

procedure TChessButton.CMFMouseLeave(var Message: TMessage);
begin
  FMouse:=false;
  Paint;
end;


end.

Nie używaj komponentów do gromadzenia danych, jeśli nigdy ich nie wyświetlasz na formularzu; Dlatego też wywal używanie TImage i skorzystaj ze zwyklej klasy, przechowującej określony obraz; Na przykład, jeśli masz 24-bitowy obraz to użyj klasy TBitmap, a jeśli chcesz mieć przezroczystość (grafikę 32-bitową) to do dyspozycji jest klasa TPortableNetworkGraphic; Obie wymienione klasy znajdują się w module Graphics;

Druga rzecz, nigdy nie używaj metody Paint bezpośrednio, o czym wielokrotnie wspominałem wcześniej - wołaj Invalidate; W pewnych przypadkach komponent nie może być przemalowany, a próba wymuszenia odmalowania skończy się wyjątkiem (np. podczas ładowania komponentu lub jego niszczenia); Dlatego też metoda Invalidate posiada w sobie odpowiednie warunki, co możesz sam sprawdzić[#]_;

Trzecia rzecz - nie podobają mi się deklaracje właściwości obrazków; Ale jestem już tak zmęczony, że jutro coś bąknę na ten temat; Tak samo co do komunikatów CM_FMouseENTER i CM_FMouseLEAVE - co to za pieroństwo? Nie znam takich;

Z innych rzeczy to przydałoby się poznać funkcję Rect oraz instrukcję wiążącą (With); Poza tym usuwaj nieużywane moduły z listy Uses; Do tego celu przeznaczona jest opcja w edytorze - PPM ☛ Refactoring ☛ Unused units ...

.. [#] Aby szybko przemieszczać się wgłąb implementacji nadpisywanych metod, zaprzyjaźnij się ze skrótami klawiszowymi Alt+Up oraz Shift+Ctrl+Up/Down; Ich przeznaczenie masz opisane w opcjach mapowania klawiszy IDE, więc sobie poczytaj i poćwicz.

furious programming napisał(a):

do dyspozycji jest klasa TPortableNetworkGraphic; Obie wymienione klasy znajdują się w module Graphics;

Przeglądałem źródła innych komponentów po wrzuceniu posta i faktycznie zauważyłem, że to jest używane. Poprawię to.

furious programming napisał(a):

Tak samo co do komunikatów CM_FMouseENTER i CM_FMouseLEAVE - co to za pieroństwo? Nie znam takich;

Z racji tego, że nigdy wcześniej nie pisałem takich rzeczy i nie starałem się ogarnąć świadomie takich zdarzeń po prostu to skopiowałem z jakiegoś artykułu o pisaniu komponentów. Ale z tego co widziałem w artykułach na 4p powinno się użyć CM_MOUSEENTER etc

W takim razie czas na wprowadzenie dzisiaj poprawek ;)

Przeglądałem źródła innych komponentów po wrzuceniu posta i faktycznie zauważyłem, że to jest używane. Poprawię to.

Musisz zrozumieć pewną rzecz - komponenty służą do wizualnego przedstawienia danych w oknach aplikacji; Wszystko co niewidoczne w okienkach, powinno być przechowywane w sposób minimalistyczny, w klasach o jak najmniejszej złożoności i funkcjonalności; Dlatego też np. do przechowywania łańcucha znaków używa się pola typu String, a nie komponentu TMemo, a do trzymania obrazu używa się np. instancji klasy TBitmap, TPortableNetworkGraphic, TJPEGImage itd.;

Wszystkie klasy do przechowywania obrazków posiadają wspólną funkcjonalność, zdefiniowaną w klasach o wyższym poziomie abstrakcji; Wymienione wyżej trzy klasy dziedziczą z tej samej - TFPImageBitmap - więc większa część funkcjonalności jest taka sama; One wszystkie posiadają to, co jest Ci potrzebne, czyli np. metodę LoadFromFile;

Z racji tego, że nigdy wcześniej nie pisałem takich rzeczy i nie starałem się ogarnąć świadomie takich zdarzeń po prostu to skopiowałem z jakiegoś artykułu o pisaniu komponentów. Ale z tego co widziałem w artykułach na 4p powinno się użyć CM_MOUSEENTER etc

W module Controls zdefiniowane są wszystkie stałe o prefiksie CM_ (CN_ też), w tym również CM_MOUSEENTER i CM_MOUSELEAVE; Stałe te wykorzystywane są we wszystkich klasach komponentów z biblioteki LCL, które posiadają zdarzenia OnMouseEnter i OnMouseLeave;

Dlatego też jeśli potrzebujesz w swoim komponencie dodać obsługę tych komunikatów to należy właśnie z nich skorzystać; Pozostałe stałe komunikatów zadeklarowane są w module LMessages (prefiks LM_ i SC_) oraz Windows (prefiksy WM_ i pozostałe);

I nie zapomnij o skrótach klawiszowych, które podałem w przypisie poprzedniego posta.

Ostateczna wersja komponentu. Walczyłem z tym strasznie długo ale myślę, że jest ok :) Było dużo zabawy ze sprawdzaniem czy plik z grafiką istnieje, jest ustawiona ścieżka etc więc zrobiłem property jako wskazywanie bitmapy i działa bez zarzutu.

Wrzucam poniżej ku pamięci i jednocześnie proszę o opinię.
ps. wiem, ze nazwa klasy powinna byc inna ale to na moj uzytek wiec... zostawiam.

unit ChessButton;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, LResources, Forms, Controls, Windows, Graphics, Dialogs, Buttons;

type
  TChessButton = class(TSpeedButton)
  private
    { Private declarations }
    FEnter,FLeave: TBitMap;
    FMouse:boolean;

    procedure SetBitMapEnter(const AValue: TBitmap);
    procedure SetBitMapLeave(const AValue: TBitmap);
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
  protected
    { Protected declarations }
    procedure Paint; override;
  public
    { Public declarations }
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
  published
    { Published declarations }
    property ImgEnter: TBitmap read FEnter write SetBitMapEnter;
    property ImgLeave: TBitmap read FLeave write SetBitMapLeave;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Additional',[TChessButton]);
end;

constructor TChessButton.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);
  Font.Color:=clWhite;
  FMouse:=false;
  FEnter := TBitMap.Create;
  FLeave := TBitMap.Create;
end;

destructor TChessButton.Destroy;
begin
  FreeAndNil(FEnter);
  FreeAndNil(FLeave);
  inherited;
end;

procedure TChessButton.Paint;
var
 aRect:TRect;
begin

  aRect.Top:=0;
  aRect.Left:=0;
  aRect.Right:=Width;
  aRect.Bottom:=Height;


  if FMouse then
  begin
    if FEnter<> nil then Canvas.StretchDraw(aRect, FEnter);
  end
  else
  begin
    if FLeave <> nil then Canvas.StretchDraw(aRect, FLeave);
  end;

     Canvas.Pen.Color:=clBlack;

     Canvas.MoveTo(0, 0);
     Canvas.LineTo(0, Height);

     Canvas.MoveTo(0, Height-1);
     Canvas.LineTo(Width, Height-1);

     Canvas.MoveTo(Width-1,height);
     Canvas.LineTo(Width-1,0);

     Canvas.MoveTo(Width,0);
     Canvas.LineTo(0,0);

     Canvas.Brush.Style := bsClear;

     SetTextAlign( Canvas.handle, TA_CENTER );
     Canvas.TextOut((Round(Width/2)), aRect.Top + 7, Caption);
     SetTextAlign( Canvas.handle, TA_LEFT );
     Font.Style := [];

end;

procedure TChessButton.SetBitMapEnter(const AValue: TBitmap);
begin
  FEnter.Assign(AValue);
end;

procedure TChessButton.SetBitMapLeave(const AValue: TBitmap);
begin
  FLeave.Assign(AValue);
end;

procedure TChessButton.CMMouseEnter(var Message: TMessage);
begin
    FMouse:=true;
    Invalidate;
end;

procedure TChessButton.CMMouseLeave(var Message: TMessage);
begin
    FMouse:=false;
    Invalidate;
end;

end.

destructor TChessButton.Destroy;
begin
  FreeAndNil(FEnter);
  FreeAndNil(FLeave);
  inherited;
end;

Komponent i tak jest zwalniany z pamięci, więc zwykłe Free spokojnie wystarczy; Natomiast użycie FreeAndNil błędnie sugeruje, że obiekt jest celowo **Nil**owany do późniejszego użytku, co w przypadku destruktora jedynie myli, bo nic nie daje;

aRect.Top:=0;
aRect.Left:=0;
aRect.Right:=Width;
aRect.Bottom:=Height;

Pisałem Ci wczesniej o funkcji Rect - użyj jej, aby skrócić kod:

ARect := Rect(0, 0, Width, Height);

Na to samo wychodzi, a zajmuje jedną linijkę i jest czytelniejsze;

if FMouse then
begin
  if FEnter<> nil then Canvas.StretchDraw(aRect, FEnter);
end
else
begin
  if FLeave <> nil then Canvas.StretchDraw(aRect, FLeave);
end;

pola FMouse, FEnter i FLeave nic nie mówią o swoim przeznaczeniu, a to niedobrze - powinieneś je nazwać inaczej; Przy czym **Begin**y i **End**y nie są konieczne, bo grupujesz po jednej instrukcji, a to nie jest konieczne;

Choć tej drabinki **If**ów można by się pozbyć, za pomocą dodatkowego pola - FCurrentImage; W CMMouseEnter przepisujesz referencję z FEnter do FCurrentImage, a w CMMouseLeave z FLeave (zawsze przed Invalidate); Natomiast w metodzie Paint zawsze malujesz obraz, na który wskazuje to dodatkowe pole:

Canvas.StretchDraw(ARect, FCurrentImage);

Sprawdzanie czy pole wskazuje na Nil nie jest konieczne, dlatego że tym zajmuje się metoda StretchDraw w sobie; Zresztą pola FEnter i FLeave nigdy nie będą **Nil**ami, bo istnieją w pamięci przez cały czas życia komponentu;

Canvas.MoveTo(0, 0);
Canvas.LineTo(0, Height);

Zły dotyk Delphi7... W LCL, klasa Canvas posiada zestaw przeładowanych, dwu- lub czteroargumentowych metod Line, od razu do podania współrzędnych dwóch punktów:

Canvas.Line(0, 0, 0, Height);

Przy czym poniższy kod:

Canvas.MoveTo(0, 0);
Canvas.LineTo(0, Height);

Canvas.MoveTo(0, Height-1);
Canvas.LineTo(Width, Height-1);

Canvas.MoveTo(Width-1,height);
Canvas.LineTo(Width-1,0);

Canvas.MoveTo(Width,0);
Canvas.LineTo(0,0);

o ile dobrze widzę, służy do namalowania prostokątnej ramki, dlatego też należy go zamienić na metodę FrameRect:

Canvas.Brush.Color := clBlack;
FrameRect({tutaj obszar});

Przy czym pamiętaj, że FrameRect używa koloru z właściwości Brush, a nie z Pen;

Round(Width/2)

Chyba nie powiesz mi, że nie znasz operatora Div? :]

Width div 2

Haksiory używają do tego przesunięć bitowych, jeśli dzielnikiem jest dowolna potęga dwójki (2, 4, 8 itd.):

Width shr 1

Analogicznie z mnożeniem przez potęgę dwójki, tyle że za pomocą operatora Shl;

To w sumie tyle na razie; Jak widzisz - kod króciutki, a kupa rzeczy do poprawienia; Musisz lepiej poznać RTL oraz LCL - o wiele łatwiej będzie Ci pisać kod, a ten w lepszy sposób napisany, będzie 2x krótszy i 2x szybszy od bieżącego.

Wielkie dzięki za uwagi. Coraz bardziej zaczynam łapać o co w tym wszystkim chodzi ale jednocześnie widzę, że jeszcze mnóstwo nauki przede mną (i ciągle dochodzi więcej).

furious programming napisał(a):

Sprawdzanie czy pole wskazuje na Nil nie jest konieczne, dlatego że tym zajmuje się metoda StretchDraw w sobie; Zresztą pola FEnter i FLeave nigdy nie będą **Nil**ami, bo istnieją w pamięci przez cały czas życia komponentu;

Tutaj chciałem sprawdzić czy jakiś obraz jest załadowany żeby nie próbować malować czegoś czego nie ma. Ale faktycznie teraz widzę, że to co zrobiłem jest beznadziejne ;)

Mozna to zrobić poprzez

Assigned(FEnter)

czy można w ogóle pominąć sprawdzanie tego?

Tutaj chciałem sprawdzić czy jakiś obraz jest załadowany żeby nie próbować malować czegoś czego nie ma.

No dobrze, ale zobacz w jaki sposób sprawdzasz ten obrazek; Ty nie patrzysz na to, czy obiekt klasy TBitmap zawiera jakiś obraz, a na to, czy obiekt klasy TBitmap w ogóle istnieje w pamięci; To dwie różne rzeczy, bo obiekt może istnieć w pamięci, ale nie zawierać w sobie obrazu (w odwrotną stronę to nie działa, chyba że instancja wyciekła do pamięci);

To sprawdzenie i tak nie ma sensu, bo Assigned(FEnter) zawsze zwróci True, dlatego że obiekt ten tworzysz w konstruktorze klasy, a zwalniasz dopiero w jej destruktorze;

Poniżej moja sugestia dotycząca dodatkowego pola z obrazkiem, a także ze zoptymalizowaną wersją metody Paint:

type
  TChessButton = class(TSpeedButton)
  private
    FNormalImage: TPortableNetworkGraphic;
    FHoverImage: TPortableNetworkGraphic;
    FCurrentImage: TPortableNetworkGraphic;
  {..}
  end;

constructor TChessButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  FNormalImage := TPortableNetworkGraphic.Create();
  FHoverImage := TPortableNetworkGraphic.Create();

  FCurrentImage := FNormalImage;
end;

destructor TChessButton.Destroy();
begin
  FNormalImage.Free();
  FHoverImage.Free();

  inherited Destroy();
end;

procedure Paint();
begin
  with Canvas do
  begin
    StretchDraw(ClientRect, FCurrentImage);

    Brush.Color := clBlack;
    FrameRect(ClientRect);

    TextOut((Width - TextWidth(Caption)) div 2, 7, Caption);
  end;
end;

procedure TChessButton.CMMouseEnter(var AMessage: TLMessage);
begin
  FCurrentImage := FHoverImage;
  inherited Invalidate();
end;

procedure TChessButton.CMMouseLeave(var AMessage: TLMessage);
begin
  FCurrentImage := FNormalImage;
  inherited Invalidate();
end;

Prawda, że lepiej? :]

Tak jak na to patrzę to napisanie takiego czegoś dla doświadczonego kodera to 5 minut włącznie z odpaleniem IDE ;)

Dzięki, bardzo doceniam Twoją pomoc!