Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Object-Pascal / Delphi-Language (https://www.delphipraxis.net/32-object-pascal-delphi-language/)
-   -   Delphi Unbekannter Sender wird durchgeschliffen (https://www.delphipraxis.net/80940-unbekannter-sender-wird-durchgeschliffen.html)

Martin W 17. Nov 2006 18:50


Unbekannter Sender wird durchgeschliffen
 
Also folgendes Problem. Erst mal ein bissel Code zum nachvollziehen:

Delphi-Quellcode:
unit uTemplateManagement;
 
interface

uses
  // Windows, Borland VCL, Jedi
  Windows, Messages, Classes, Controls, Forms, JvNavigationPane, ExtCtrls,
  StdCtrls, AppEvnts, jpeg, SysUtils, Dialogs,
  // Andere Units von uns
  uGlobals;

type
  TTemplateManagement = class(TObject)
  private
    procedure CreateLabel(Sender: TObject;
      LabelObject: TLabel; Top, Left, Height, Width: integer; SendToFront,
      Transparent, AutoSize: boolean; LabelCaption: string; Alignment: TAlignment;
      Layout: TTextLayout; FontSize: integer; FontName: string; ShowLabel: boolean;
      Anchors: TAnchors; Cursor: TCursor);
  public
    procedure LoadTemplate(Sender: TObject; aButtons: TAvButtonsCount;
      CoreForm: boolean);
  end;

var
  TemplateManagement: TTemplateManagement;


type
   TButtonImageSubID = class(TObject)
        public
          FPushed: integer;
          FHover: integer;
          FNormal: integer;
        end;

type
  TButtonImageID = class(TObject)
        public
          FOK    : TButtonImageSubID;
          FCancel : TButtonImageSubID;
          FExit  : TButtonImageSubID;
          FClose : TButtonImageSubID;
          FApply : TButtonImageSubID;
        end;


type
  TBmsForm = class(TForm)
  public
    // Designvariablen, hier werden alle Bilder hineingeladen die zur
    // Laufzeit erstellt werden
    FormImages: array of TImage;

    // ID der Images der Buttons
    ButtonImageID: TButtonImageID;

    // Die Labels ermöglichen den Zugriff / Hovern der Buttons
    LblOK    : TLabel;
    LblCancel : TLabel;
    LblExit  : TLabel;
    LblApply : TLabel;
    LblClose : TLabel;

    // Hovereffekte für die Buttons
    procedure ButtonMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
  end;


implementation

uses ufoBasicForm, ufoAdmin_ServerConfig, ufoAbout;


{-----------------------------------------------------------------------------
  Author:      Martin
  Changes by:
  Status:      Not Finished

  Hovereffekt für die Buttons
-----------------------------------------------------------------------------}
procedure TBmsForm.ButtonMouseMove(Sender: TObject; Shift: TShiftState;
  X: Integer; Y: Integer);
var
  Parent: TBmsForm;
  ImageKind: ^TButtonImageSubID;
begin
 // Hover Image anzeigen, anderes Image verbergen
  Parent := ((sender as TLabel).Parent as TBmsForm);

  ImageKind := nil;

  // ImageKind festlegen
  if Sender = LblOK then
    ImageKind := @Parent.ButtonImageID.FOK;

  if Sender = LblCancel then
    ImageKind := @Parent.ButtonImageID.FCancel;

  if Sender = LblExit then
    ImageKind := @Parent.ButtonImageID.FExit;

  if Sender = LblApply then
    ImageKind := @Parent.ButtonImageID.FApply;
   
  if Sender = LblClose then
    ImageKind := @Parent.ButtonImageID.FClose;

  // Änderung durchführen
  if ImageKind <> nil then
    begin
      Parent.FormImages[ImageKind.FNormal].Visible := False;
      Parent.FormImages[ImageKind.FHover].Visible := True;
      Parent.FormImages[ImageKind.FPushed].Visible := False;
    end;
end;


{-----------------------------------------------------------------------------
  Author:      Martin
  Changes by:
  Status:      Not Finished

  Diese Prozedur läd das Skin, also alle Bilder
-----------------------------------------------------------------------------}
procedure TTemplateManagement.LoadTemplate(Sender: TObject;
                                  aButtons: TAvButtonsCount; CoreForm: boolean);
const
  // Für den Errorreport, wenn die Anwendung eine Exception erzeugt
  cProcName = 'ufoTemplate.TTemplateForm.LoadSkinOverload';
var
  CurrentImageID    : integer;
  DesignResFile     : string;
begin

  // Name der DLL, aus dem die Bilder geladen werden
  DesignResFile := FileNameDirectories.AppDesignDir + AppCurrentDesignSourceFile;

  // Footer Buttons einfügen (2x Image + 1x Label)
  (Sender as TBmsForm).ButtonImageID := TButtonImageID.Create;

  case aButtons of
    avbOk:
      begin
        // OK Button erstellen
        (Sender as TBmsForm).ButtonImageID.FOK := TButtonImageSubID.Create;

        // Normal Status
        CurrentImageID := AddNewImage(Sender);
        PrepareImage(Sender, DesignResFile, CurrentImageID,
          (Sender as TBmsForm).ClientHeight - 26,
          (Sender as TBmsForm).ClientWidth - 81, 21, 73, True, True, False,
          [akBottom,akRight], 'ButtonNormal');
        (Sender as TBmsForm).ButtonImageID.FOK.FNormal := CurrentImageID;

        // ButtonPress Status
        CurrentImageID := AddNewImage(Sender);
        PrepareImage(Sender, DesignResFile, CurrentImageID,
          (Sender as TBmsForm).ClientHeight - 26,
          (Sender as TBmsForm).ClientWidth - 81, 21, 73, True, False, False,
          [akBottom,akRight], 'ButtonPress');
        (Sender as TBmsForm).ButtonImageID.FOK.FPushed := CurrentImageID;

        // Gehoverter Status
        CurrentImageID := AddNewImage(Sender);
        PrepareImage(Sender, DesignResFile, CurrentImageID,
          (Sender as TBmsForm).ClientHeight - 26,
          (Sender as TBmsForm).ClientWidth - 81, 21, 73, True, False, False,
          [akBottom,akRight], 'ButtonHover');
        (Sender as TBmsForm).ButtonImageID.FOK.FHover := CurrentImageID;

        // ButtonLabel erstellen, für Hover / OnClick
        CreateLabel(Sender, (Sender as TBmsForm).LblOK,
          (Sender as TBmsForm).ClientHeight - 26,
          (Sender as TBmsForm).ClientWidth - 81, 21, 73, True,
          True, False, 'OK', taCenter, tlCenter, 7, 'Tahoma',
          True, [akBottom,akRight], crHandPoint);
      end;

   { ... }
  end;

end;

{-----------------------------------------------------------------------------
  Author:      Martin
  Changes by:
  Status:      Not Finished

  Bereitet ein Label für seine Benutzung vor
-----------------------------------------------------------------------------}
procedure TTemplateManagement.CreateLabel(Sender: TObject;
  LabelObject: TLabel; Top, Left, Height, Width: integer; SendToFront,
  Transparent, AutoSize: boolean; LabelCaption: string; Alignment: TAlignment;
  Layout: TTextLayout; FontSize: integer; FontName: string; ShowLabel: boolean;
  Anchors: TAnchors; Cursor: TCursor);
begin
  LabelObject := TLabel.Create((Sender as TBmsForm));
  LabelObject.Parent := (Sender as TBmsForm);
  LabelObject.Top := Top;
  { ... }
  LabelObject.Font.Size := FontSize;
  LabelObject.Font.Name := FontName;
  LabelObject.OnMouseMove := (Sender as TBmsForm).ButtonMouseMove;

  if ShowLabel = True then
    begin
      LabelObject.Show;
    end
  else
    begin
      LabelObject.Hide;
    end;

end;

Und jetzt die Unit der Form, von der aus das aufgerufen wird...

Delphi-Quellcode:
unit ufoTemplate;

interface

uses
  // Borland, INDY, JEDI und Windows Units
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, jpeg, AppEvnts,
  // unsere Units
  uGlobals, uTemplateManagement;

type
  // Die Form
  TTemplateForm = class(TBmsForm)
    ImgPlaceHolder2: TImage;
    ImgPlaceHolder1: TImage;
    // Form anzeigen
    procedure FormShow(Sender: TObject);
  private
    { private }
  public
    { public }
  end;

var
  // Die Form
  TemplateForm: TTemplateForm;

implementation

{$R *.dfm}


{-----------------------------------------------------------------------------
  Author:      Martin
  Changes by:
  Status:      Not Finished

  Das Design laden, den Formmanager intialisieren, FastUseID erstellen
-----------------------------------------------------------------------------}
procedure TTemplateForm.FormShow(Sender: TObject);
const
  // Für den Errorreport, wenn die Anwendung eine Exception erzeugt
  cProcName = 'ufoTemplate.TTemplateForm.FormShow';
begin
  // Errorlogeintrag hinzufügen
  LastExecutedMethodes.AddMethode(cProcName);

  // Das Design laden, den Formmanager intialisieren, FastUseID erstellen
  TemplateManagement.LoadTemplate(self, avbOk, False);
end;
Ich denk mal das ist so weit verständlich. Das Problem ist folgendes:

Wenn ich jetzt mit der Maus über das Label LblOK hover, welches in der TBmsForm liegt, also Teil der Form ist, wird der Sender nicht mitgegeben...

Normalerweise sollte er bei der Procedure

Zitat:

TBmsForm.ButtonMouseMove(Sender: TObject; Shift: TShiftState;
X: Integer; Y: Integer);
als Sender dann das LblOK mitgeben... aber die Abfrage

Zitat:

if Sender = LblOK then
trifft nicht zu...

Wo liegt mein Fehler ? Wenn ihr noch Fragen habt, bitte melden.

Gruß


****UPDATE****

Eins sollt ich noch anmerken: Wenn ich folgendes schreib:

Delphi-Quellcode:
{-----------------------------------------------------------------------------
  Author:      Martin
  Changes by:
  Status:      Not Finished

  Hovereffekt für die Buttons
-----------------------------------------------------------------------------}
procedure TBmsForm.ButtonMouseMove(Sender: TObject; Shift: TShiftState;
  X: Integer; Y: Integer);
var
  Parent: TBmsForm;
  ImageKind: ^TButtonImageSubID;
begin
// Hover Image anzeigen, anderes Image verbergen
  Parent := ((sender as TLabel).Parent as TBmsForm);

  ImageKind := nil;

  ImageKind := @Parent.ButtonImageID.FOK;

  // Änderung durchführen
  if ImageKind <> nil then
    begin
      Parent.FormImages[ImageKind.FNormal].Visible := False;
      Parent.FormImages[ImageKind.FHover].Visible := True;
      Parent.FormImages[ImageKind.FPushed].Visible := False;
    end;
end;
funktioniert der Code einwandfrei... aber dann hat der Code ja keinen Sinn mehr :-/

[edit=Admin]Beitrag auf Wunsch des Autors editiert. Mfg, Daniel[/edit]

3_of_8 17. Nov 2006 18:53

Re: Unbekannter Sender wird durchgeschliffen
 
Lass dir mal im Evaluator (Sender as TComponent).Name ausgeben.

Martin W 17. Nov 2006 18:57

Re: Unbekannter Sender wird durchgeschliffen
 
Hab ich schon, dann wird ne leere Menge = '' als Result ausgegeben...

Martin W 17. Nov 2006 20:20

Re: Unbekannter Sender wird durchgeschliffen
 
Problem gelöst... es hätte

Delphi-Quellcode:
procedure CreateLabel(Sender: TObject;
      var LabelObject: TLabel; Top, Left, Height, Width: integer; SendToFront,
      Transparent, AutoSize: boolean; LabelCaption: string; Alignment: TAlignment;
      Layout: TTextLayout; FontSize: integer; FontName: string; ShowLabel: boolean;
      Anchors: TAnchors; Cursor: TCursor);
heißen müssen und nicht

Delphi-Quellcode:
procedure CreateLabel(Sender: TObject;
      LabelObject: TLabel; Top, Left, Height, Width: integer; SendToFront,
      Transparent, AutoSize: boolean; LabelCaption: string; Alignment: TAlignment;
      Layout: TTextLayout; FontSize: integer; FontName: string; ShowLabel: boolean;
      Anchors: TAnchors; Cursor: TCursor);


Alle Zeitangaben in WEZ +1. Es ist jetzt 04:07 Uhr.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz