AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Thema durchsuchen
Ansicht
Themen-Optionen

Unbekannter Sender wird durchgeschliffen

Ein Thema von Martin W · begonnen am 17. Nov 2006 · letzter Beitrag vom 17. Nov 2006
Antwort Antwort
Martin W

Registriert seit: 29. Mai 2004
Ort: Augsburg
220 Beiträge
 
Delphi XE3 Enterprise
 
#1

Unbekannter Sender wird durchgeschliffen

  Alt 17. Nov 2006, 18:50
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]
  Mit Zitat antworten Zitat
Benutzerbild von 3_of_8
3_of_8

Registriert seit: 22. Mär 2005
Ort: Dingolfing
4.129 Beiträge
 
Turbo Delphi für Win32
 
#2

Re: Unbekannter Sender wird durchgeschliffen

  Alt 17. Nov 2006, 18:53
Lass dir mal im Evaluator (Sender as TComponent).Name ausgeben.
Manuel Eberl
„The trouble with having an open mind, of course, is that people will insist on coming along and trying to put things in it.“
- Terry Pratchett
  Mit Zitat antworten Zitat
Martin W

Registriert seit: 29. Mai 2004
Ort: Augsburg
220 Beiträge
 
Delphi XE3 Enterprise
 
#3

Re: Unbekannter Sender wird durchgeschliffen

  Alt 17. Nov 2006, 18:57
Hab ich schon, dann wird ne leere Menge = '' als Result ausgegeben...
  Mit Zitat antworten Zitat
Martin W

Registriert seit: 29. Mai 2004
Ort: Augsburg
220 Beiträge
 
Delphi XE3 Enterprise
 
#4

Re: Unbekannter Sender wird durchgeschliffen

  Alt 17. Nov 2006, 20:20
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);
  Mit Zitat antworten Zitat
Antwort Antwort


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 12:06 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