Witam!
Wpadłem na pomysł by napisać komponent bazujący na TImage i zrobić coś na kształt SpeedButtona, który mógłby obsługiwać PopupMenu i Panel. Co jakiś czas sprawdzałem działanie komponentu i odkryłem że gdy nie mam podłączonego Panelu i kliknę w "buttona" to wywala mi błąd w programie testującym. Drugim problemem jest moment gdy wybiorę w MStyles coś innego niż wartość domyślna to przy uruchamianiu programu wywala błąd że taka właściwość nie istnieje.
Aby lepiej zrozumieć o co chodzi załaczam źródło komponentu:
unit PMenus;
interface
uses
SysUtils, Classes, Controls, ExtCtrls, Messages, Graphics, Menus;
type
TMStyle=(msNormal, msWord, msInAll);
TPMenu = class(TImage)
private
FPanel: TPanel;
FMenu: TPopupMenu;
FMStyles: TMStyle;
FPClick, FPNormal, FPActive: TPicture;
FOnMouseEnter, FOnMouseLeave: TNotifyEvent;
protected
procedure CmMouseEnter(var Msg: TMessage); message CM_MOUSEENTER;
procedure CmMouseLeave(var Msg: TMessage); message CM_MOUSELEAVE;
procedure WMLButtonDown(var Msg: TMessage); message WM_LBUTTONDOWN;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X,Y: Integer);override;
procedure Notification(AComponent: TComponent; Operation: TOperation);override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function IsClicked: Boolean;
procedure SetPClick(Img: TPicture);
procedure SetPNormal(Img: TPicture);
procedure SetPActive(Img: TPicture);
published
property Panel: TPanel read FPanel write FPanel;
property Menu: TPopupMenu read FMenu write FMenu;
property MStyles: TMStyle read FMStyles write FMStyles default msNormal;
property PClick: TPicture read FPClick write SetPClick;
property PNormal: TPicture read FPNormal write SetPNormal;
property PActive: TPicture read FPActive write SetPActive;
property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
end;
procedure Register;
implementation
var IsClick: Boolean;
constructor TPMenu.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Height:=25;
Width:=25;
IsClick:=false;
Picture:=TPicture.Create;
FPNormal:=TPicture.Create;
FPClick:=TPicture.Create;
FPActive:=TPicture.Create;
FMStyles:=msNormal;
FMenu:=NIL;
FPanel:=NIL;
end;
function TPMenu.IsClicked: Boolean;
begin
Result:=IsClick;
end;
procedure TPMenu.Notification(AComponent: TComponent; Operation: TOperation);
begin
if Operation=opRemove then
begin
if AComponent=FMenu then FMenu:=NIL;
if AComponent=FPanel then FPanel:=NIL;
end;
end;
procedure TPMenu.MouseDown(Button: TMouseButton; Shift: TShiftState; X,Y: Integer);
begin
inherited MouseDown(Button,Shift,X,Y);
if Assigned(FMenu) then FMenu.Popup((Self.ClientOrigin.X),(Self.ClientOrigin.Y+Height));
end;
procedure TPMenu.SetPClick(Img: TPicture);
begin
FPClick.Assign(Img);
end;
procedure TPMenu.SetPNormal(Img: TPicture);
begin
FPNormal.Assign(Img);
Picture:=FPNormal;
end;
procedure TPMenu.SetPActive(Img: TPicture);
begin
FPActive.Assign(Img);
end;
procedure TPMenu.WMLButtonDown(var Msg: TMessage);
begin
if IsClick then
begin
IsClick:=false;
Picture:=FPNormal;
if Assigned(FPanel) then FPanel.Visible:=false;
end else
begin
IsClick:=true;
Picture:=FPClick;
if Assigned(FPanel) then
begin
case FMStyles of
msNormal: begin
FPanel.Top:=Top+Height;
FPanel.Left:=Left;
end;
msWord: begin
FPanel.Top:=Top+(Height div 2);
FPanel.Left:=Left;
end;
msInAll: begin
FPanel.Top:=Top-1;
FPanel.Left:=Left-1;
end;
end;
FPanel.Visible:=true;
end;
end;
end;
procedure TPMenu.CmMouseEnter(var Msg: TMessage);
begin
if Assigned(FOnMouseEnter) then OnMouseEnter(Self);
if IsClick then Picture:=FPClick
else Picture:=FPActive;
end;
procedure TPMenu.CmMouseLeave(var Msg: TMessage);
begin
if Assigned(FOnMouseLeave) then OnMouseLeave(Self);
if not IsClick then Picture:=FPNormal;
end;
destructor TPMenu.Destroy;
begin
inherited;
end;
procedure Register;
begin
RegisterComponents('Pabloch Software', [TPMenu]);
end;
end.
Nie wiem czy robię coś źle, ale zwracam się do was, ponieważ wielu z was ma większe doświadczenie w pisaniu komponentów. Mam nadzieję że zauważycie jakiś błąd w kodzie, którego ja się nie dopatrzyłem.
Z góry dziękuję za odpowiedź. Pozdrawiam!