Problem beim Vererben

[Christian18]

Zitat von Christian18:

Fehler noch nicht gefunden. Das kleine Bsp. funktioniert nach deinem Tip. Aber das Große nicht.

Ist genauso aufgebaut wie das kleine beispeil

Delphi-Quellcode:

unit UMainForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, XMLDoc, UProgram;

type
  TFMainForm = class(TForm)
    PMain: TPanel;
    ITop: TImage;
    IBottom: TImage;
  private
    Prg: TProgram;
    FMenuBtn: Array of TImage;
    FMenuText: Array of TLabel;
    { Private-Deklarationen }
  public
    FMenuActive: TImage;
    procedure CreateMenu(AForm: TForm; AClass : TClass);
    procedure MoveMenu(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure LeaveMenu(Sender: TObject);
    { Public-Deklarationen }
  end;

var
  FMainForm: TFMainForm;

implementation

{$R *.dfm}

procedure TFMainForm.CreateMenu(AForm: TForm; AClass : TClass);
  var lXml: TXMLDocument;
      Count: Word;
      i: Word;
      Method: TMethod;
begin
  lXml:=TXMLDocument.Create(Application);
  try
    Prg:=TProgram.Create();
    try
      lXml.LoadFromFile(Prg.GetAppPath() + 'Settings\Menu.xml');

      Count:=lXml.DocumentElement.ChildNodes[AForm.Name].ChildNodes.Count;
      SetLength(FMenuBtn, Count);
      SetLength(FMenuText, Count);
      for i:=1 to Count do
        begin
          FMenuBtn[i - 1]:=TImage.Create(PMain);
          FMenuText[i - 1]:=TLabel.Create(PMain);

          with FMenuBtn[i - 1] do
            begin
              Name:='IItem' + IntToStr(i);
              Width:=100;
              Height:=75;
              Left:=PMain.Width - Count * Width - (Count - 1) * 8 + (i - 1) * Width + (i - 1) * 8;
              Top:=0;
              if i = 1 then
                begin
                  Picture.LoadFromFile(Prg.GetAppPath() + 'Img\BtnMove.bmp');
                  FMenuActive:=FMenuBtn[i - 1];
                end
              else
                begin
                  Picture.LoadFromFile(Prg.GetAppPath() + 'Img\BtnLeave.bmp');
                end;

              Method.Data:=FMenuBtn[i - 1];
              Method.Code:=AClass.MethodAddress(lXml.DocumentElement.ChildNodes[AForm.Name].ChildNodes[i - 1].Attributes['OnClick']);
              OnClick:=TNotifyEvent(Method);

              //OnMouseMove:=MoveMenu;
              //OnMouseLeave:=LeaveMenu;

              Parent:=PMain;
            end;

          with FMenuText[i - 1] do
            begin
              Name:='LItem' + IntToStr(i);
              Left:=FMenuBtn[i - 1].Left + 4;
              Top:=57;
              Caption:=lXml.DocumentElement.ChildNodes[AForm.Name].ChildNodes[i - 1].Attributes['Caption'];
              Transparent:=True;

              Method.Data:=FMenuBtn[i - 1];
              Method.Code:=AClass.MethodAddress(lXml.DocumentElement.ChildNodes[AForm.Name].ChildNodes[i - 1].Attributes['OnClick']);
              OnClick:=TNotifyEvent(Method);

              //OnMouseMove:=MoveMenu;
              //OnMouseLeave:=LeaveMenu;

              Parent:=PMain;
            end;
        end;
    finally
      Prg.Free();
    end;
  finally
    lXml.Free();
  end;
end;

procedure TFMainForm.MoveMenu(Sender: TObject; Shift: TShiftState; X: Integer; Y: Integer);
  var Item : String;
begin
  Item:=TComponent(Sender).Name;
  Item[1]:='I';
  TImage(PMain.FindComponent(Item)).Picture.LoadFromFile(Prg.GetAppPath + 'Img\BtnMove.bmp');
end;

procedure TFMainForm.LeaveMenu(Sender: TObject);
  var Item : String;
begin
  Item:=TComponent(Sender).Name;
  Item[1]:='I';
  TImage(PMain.FindComponent(Item)).Picture.LoadFromFile(Prg.GetAppPath() + 'Img\BtnLeave.bmp');
  FMenuActive.Picture.LoadFromFile(Prg.GetAppPath() + 'Img\BtnMove.bmp');
end;

end.

Edit:

FMain erbt von FMainForm. In der Klasse TFMain wird bei OnCreate die Methode "CreateMenu" der Klasse FMainForm aufgerufen. Genauso wie im beispiel

Delphi-Quellcode:

unit UMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, UMainForm, UProgram, UBackground;

type
  TFMain = class(TFMainForm)
    procedure FormCreate(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormShow(Sender: TObject);
    procedure FormPaint(Sender: TObject);    
    procedure FormResize(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Overview(Sender: TObject);
    procedure New(Sender: TObject);
  private
    Prg: TProgram;
    Bg: TBackground;
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  FMain: TFMain;

implementation

{$R *.dfm}

procedure TFMain.FormCreate(Sender: TObject);
begin
  inherited;
  Prg:=TProgram.Create();
  Bg:=TBackground.Create();

  FMain.DoubleBuffered:=True;

  FMain.Caption:=Prg.GetAppName();
  Application.Title:=Prg.GetAppName();

  CreateMenu(FMain, TFMain);
end;

procedure TFMain.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  inherited;
  if Shift = [] then
    begin
      case Key of
        27 : Close;
      end;
    end;
end;

procedure TFMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  inherited;
  if MessageDlg('Wollen Sie das Programm wirklich beenden?', mtConfirmation, [mbYes, mbNo], 0) = mrYes then
    begin
      CanClose:=True;
    end
  else
    begin
      CanClose:=False;
    end;
end;

procedure TFMain.FormShow(Sender: TObject);
begin
  inherited;
  // keine Ahnung
end;

procedure TFMain.FormPaint(Sender: TObject);
begin
  inherited;
  with Bg do
    begin
      BgColor:=clBlack;
      LineColor:=clGray;
      Distance:=2;

      Vertical(FMain);
    end;
end;

procedure TFMain.FormResize(Sender: TObject);
begin
  inherited;
  PMain.Left:=Round(FMain.ClientWidth / 2 - PMain.Width / 2);
  PMain.Top:=Round(FMain.ClientHeight / 2 - PMain.Height / 2);
end;

procedure TFMain.FormDestroy(Sender: TObject);
begin
  inherited;
  Prg.Free();
  Bg.Free();
end;

procedure TFMain.Overview(Sender: TObject);
begin
  // Übersicht
end;

procedure TFMain.New(Sender: TObject);
begin
  // Neu
  FMenuActive.Picture.LoadFromFile(Prg.AppPath() + 'Img\Btn.Leave.bmp');  // hier kommt die exception glaube ich her
  TImage(Sender).Picture.LoadFromFile(Prg.AppPath() + 'Img\Btn.Move.bmp');
  FMenuActive:=TImage(Sender)
end;

end.