Witam wszystkich, potrzebuję zrobić do programu przycisk wizualny, tzn. coś w rodzaju TPNGButton tylko szybszy. TPNGButton jest strasznie wolny, gdy pod nim jest jakaś grafika. W moim programie tłem formularza jest grafika typu PNG w komponencie TImage i na nim jest umieszczana cała masa różnych komponentów, dlatego zależy mi na tym, żeby był szybki.
Co potrzebuję... komponent, który jest zbudowany na tej samej zasadzie, co TPNGButton, czyli z grafik, które obsługują kanał alfa (np. ico czy png). Musi być także zdarzenie OnMouseEnter i OnMouseLeave, żeby grafika się zmieniała gdy kursor jest nad przyciskiem i gdy opuszcza jego pole. Te dwa zdarzenia muszą być zaprogramowane wewnątrz modułu komponentu (tak żebym nie musiał w programie programować ich, tylko w samym module komponentu). No i to tyle.
Co mam:
unit ImageButton;
interface
uses
SysUtils,
Classes,
Controls,
ExtCtrls,
Graphics,
Messages;
type
TImageButton = class(TImage)
private
FImageNormal: TIcon;
FImageHot: TIcon;
procedure SetNormalImage(Icon: TIcon);
procedure SetHotImage(Icon: TIcon);
protected
FMouseOver: TNotifyEvent;
FMouseOut: TNotifyEvent;
procedure CMMouseEnter(var Message:TMessage); message cm_MouseEnter;
procedure CMMouseLeave(var Message:TMessage); message cm_MouseLeave;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy(); override;
published
property ImageNormal: TIcon read FImageNormal write SetNormalImage;
property ImageHot: TIcon read FImageHot write SetHotImage;
property OnMouseOver: TNotifyEvent read FMouseOver write FMouseOver;
property OnMouseOut: TNotifyEvent read FMouseOut write FMouseOut;
end;
procedure Register;
implementation
constructor TImageButton.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FImageNormal := TIcon.Create();
FImageHot := TIcon.Create();
end;
destructor TImageButton.Destroy();
begin
FreeAndNil(FImageNormal);
FreeAndNil(FImageHot);
inherited Destroy();
end;
procedure TImageButton.SetNormalImage(Icon: TIcon);
begin
FImageNormal.Assign(Icon);
end;
procedure TImageButton.SetHotImage(Icon: TIcon);
begin
FImageHot.Assign(Icon);
end;
procedure TImageButton.CMMouseEnter(var Message: TMessage);
begin
if Assigned(FMouseOver) then
OnMouseOver(Self);
Picture.Assign(FImageHot);
Message.Result := 1;
end;
procedure TImageButton.CMMouseLeave(var Message: TMessage);
begin
if Assigned(FMouseOut) then
OnMouseOut(Self);
Picture.Assign(FImageNormal);
Message.Result := 1;
end;
procedure Register;
begin
RegisterComponents('Samples', [TImageButton]);
end;
end.
Gdy tworzę formularz i kładę na nim komponent (wizualnie), wszystko gra. Jednak gdy przycisk tworzę dynamicznie, podczas zamykania programu wyskakuje Access Violation.
Nie wiem dokładnie dlaczego, w każdym razie przycisk tworzę w OnCreate formularza i usuwam w OnClose:
type
TMainForm = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure btnCloseClk(Sender: TObject);
public
btnClose: TImageButton;
end;
implementation
procedure TMainForm.btnCloseClk(Sender: TObject);
begin
Close;
end;
procedure TMainForm.FormCreate(Sender: TObject);
begin
btnClose := TImageButton.Create(MainForm);
with btnClose do
begin
Parent := MainForm;
Width := 30;
Height := 62;
Left := MainForm.ClientWidth - 40;
Top := 148;
Cursor := crHandPoint;
ParentShowHint := False;
ShowHint := True;
Hint := 'Zamknij';
Picture.LoadFromFile('btnClose.ico');
ImageNormal.LoadFromFile('btnClose.ico');
ImageHot.LoadFromFile('btnCloseHot.ico');
OnClick := btnCloseClk;
end;
end;
procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
btnClose.Free();
btnClose := nil;
end;
Nie wiem dokładnie gdzie jest bląd, w każdym razie przy zamykaniu programu wyrzuca bląd.
Działa trochę wolno, może dlatego, że korzystam z grafiki w formacie .ico.
Jeżeli ktoś wie jak to zrobić lepiej, bardzo prosze o pomoc.
Dziękuję z góry, pozdrawiam.