Einzelnen Beitrag anzeigen

BAMatze

Registriert seit: 18. Aug 2008
Ort: Berlin
759 Beiträge
 
Turbo Delphi für Win32
 
#1

Ziehen der eigenen Komponente führt zu Delphi-Absturz

  Alt 13. Mai 2009, 14:37
Ich denke mal für die Profis unter euch ist dieser Threat sicherlich komisch, aber ich kann mir auch nach viel hin und her probieren ihn immer noch nicht erklären. Also ich hab meine Komponente jetzt eigentlich fertig. Da ist mir ein großer und 2 kleine Fehler aufgefallen. Der große ist sicherlich auch der Hauptaugenmerk dieses Threats, die kleinen sind eher banal, weswegen ich keinen gesonderten Threat aufmachen wollte. Ich weiß laut Regel soll/ muss ich dies und wenn es gewünscht ist, werde ich dies auch tun.

Also der große Fehler, dazu hier mein Quellcode der Komponente (der Quellcode der Komponente ist so wie er hier vorliegt lauffähig, Zeilen die bei der Aktivierung Probleme machen sind markiert und Auskommentiert):
Delphi-Quellcode:
unit LabEdit;

interface

uses Windows, Controls, Graphics, Classes, StdCtrls, Dialogs, Messages, Math, SysUtils;

const MouseClick = WM_LBUTTONDOWN;
      MouseOver = CM_MOUSEENTER;
      MouseLeave = CM_MOUSELEAVE;

type TOnChangeEvent = procedure of Object;

type TLabEdit = Class(TWinControl)
  private
  // Eigenschaftsvariablen
    FbEnabled, FbVisible, FbMouseOverComponent: boolean;
    FiTextLength, FiMaxTextLength: integer;
  // Komponenten
    FsTextWert: string;
    FLblAnzeige: TLabel;
    FEdEingabe: TEdit;
  // Eventvariablen
    FOnClick: TNotifyEvent;
    FOnChange: TOnChangeEvent;
  // create-Funktionen für das Label und das Edit
    function CreateLabel(PosX, PosY, Textgroesse: integer; Caption: string; visible: boolean): TLabel;
    function CreateEdit(PosX, PosY, Width, Height, Textgroesse: integer; Caption: string; visible: boolean): TEdit;
  // Interaktions-Prozeduren
    procedure FLblOnClick(Sender: TObject);
    procedure FEdKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
  // Änderungs-Prozeduren
    procedure ChangeEmbeddedEdit;
  // Setter- und Getter
    procedure SetEnabled(bWert: boolean);
    function GetEnabled: boolean;
    procedure SetText(sWert: string);
    function GetText: string;
    procedure SetVisible(bWert: boolean);
    function GetVisible: boolean;
    function GetTextLength: integer;
    procedure SetMaxTextLength(iWert: integer);
  // Event-Prozeduren
    procedure WMMouseClick(var Msn: TMessage); message MouseClick;
    procedure CMMouseOver(var Msn: TMessage); message MouseOver;
    procedure CMMouseLeave(var Msn: TMessage); message MouseLeave;
  protected
    procedure createWnd; override;
  published
    property OnChange: TOnChangeEvent read FOnChange write FOnChange;
    property Enabled: boolean read GetEnabled write SetEnabled;
    property Visible: boolean read GetVisible write SetVisible;
    property Text: string read GetText write SetText;
    property Font;
    property MaxLength: integer write SetMaxTextLength;
  public
    constructor create(AOwner: TComponent); override;
    destructor destroy; override;
    property Length: integer read GetTextLength;
End;

implementation

constructor TLabEdit.create(AOwner: TComponent);
begin
  inherited create(AOwner);
  Controlstyle := Controlstyle - [csAcceptsControls]; // Der Componente wird nicht erlaubt
                                                      // andere Componenten aufzunehmen,
                                                      // als die, die durch den Programmierer
                                                      // hier einprogrammiert werden.
  Visible := true;
  Enabled := true;

  // Eventzeiger zurücksetzen
  FOnClick := nil;
  FOnChange := nil;

  // Defaultwerte setzen
  FbEnabled := true;
  FbVisible := true;
  FsTextWert := 'Hallo';

end;

destructor TLabEdit.Destroy;
begin
  FLblAnzeige.Free;
  FEdEingabe.Free;
  inherited destroy;
end;

{////////////////////////////////////////////////////////////////////////////////////}
{/                                Create-Funktionen                                 /}
{////////////////////////////////////////////////////////////////////////////////////}

function TLabEdit.CreateLabel(PosX: Integer; PosY: Integer; Textgroesse: Integer; Caption: string; visible: Boolean): TLabel;
begin
  result := TLabel.Create(nil);
  result.Parent := Self;
  result.Left := PosX;
  result.Top := PosY;
  result.Font.Assign(Font);
  result.Caption := Caption;
  result.Visible := visible;
end;

function TLabEdit.CreateEdit(PosX, PosY, Width, Height, Textgroesse: integer; Caption: string; visible: boolean): TEdit;
begin
  result := TEdit.Create(nil);
  result.Parent := Self;
  result.Left := PosX;
  result.Top := PosY;
  result.Width := Width;
  result.Text := Caption;
  result.Font.Assign(Font);
  result.Visible := visible;
end;

{////////////////////////////////////////////////////////////////////////////////////}
{/                                Setter und Getter                                 /}
{////////////////////////////////////////////////////////////////////////////////////}

function TLabEdit.GetText: string;
begin
  result := FLblAnzeige.Caption;
end;

procedure TLabEdit.SetText(sWert: string);
begin
  FsTextWert := sWert;
  FLblAnzeige.Caption := sWert;
  FEdEingabe.Text := FLblAnzeige.Caption;
end;

procedure TLabEdit.SetEnabled(bWert: Boolean);
begin
  FbEnabled := bWert;
  //Enabled := bWert; <---- Hier gibt es den großen Fehler
end;

function TLabEdit.GetEnabled;
begin
  result := FbEnabled;
end;

procedure TLabEdit.SetVisible(bWert: boolean);
begin
  FbVisible := bWert;
  //Visible := bWert; <---- Hier gibt es den großen Fehler
end;

function TLabEdit.GetVisible:boolean;
begin
   result := FbVisible;
end;

function TLabEdit.GetTextLength: integer;
begin
  FiTextLength := strLen(PAnsiChar(FsTextWert));
  result := strLen(PAnsiChar(FsTextWert));
end;

procedure TLabEdit.SetMaxTextLength(iWert: integer);
begin
  FiMaxTextLength := iWert;
  FEdEingabe.MaxLength := FiMaxTextLength;
end;

{////////////////////////////////////////////////////////////////////////////////////}
{/                              Änderungs-Prozeduren                                /}
{////////////////////////////////////////////////////////////////////////////////////}

procedure TLabEdit.ChangeEmbeddedEdit;
begin
  Height := FEdEingabe.Height;
  FEdEingabe.Width := FLblAnzeige.Width + 20;
  Width := FEdEingabe.Width;
end;

{////////////////////////////////////////////////////////////////////////////////////}
{/                         Funktionen für die Interaktion                           /}
{////////////////////////////////////////////////////////////////////////////////////}

procedure TLabEdit.FLblOnClick(Sender: TObject);
begin
  FLblAnzeige.Visible := false;
  FEdEingabe.Visible := true;
end;

procedure TLabEdit.FEdKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
// Die Änderung hier an dieser Prozedur sehen wie folgt aus: OnChange wird nur
// aktiviert, wenn eine Eingabe getätigt wurde, die verschieden von der vorherigen
// ist.
// Bei Esc wird alles wieder zurückgesetzt und das OnChangeEvent wird nicht aktiviert.
  if key in [13, 27] then
     begin
      FEdEingabe.Visible := false;
      FLblAnzeige.Visible := true;
      case key of
      13: begin
            FLblAnzeige.Caption := FEdEingabe.Text;
            if FsTextWert <> FEdEingabe.Text then if assigned(FOnChange) then FOnchange;
            FsTextWert := FEdEingabe.Text;
          end;
      27: FEdEingabe.Text := FsTextWert;
      end;
    end
  else
    begin
      inherited;
      FLblAnzeige.Caption := FEdEingabe.Text;
      ChangeEmbeddedEdit;
    end;
end;

{////////////////////////////////////////////////////////////////////////////////////}
{/                                      Events                                      /}
{////////////////////////////////////////////////////////////////////////////////////}

procedure TLabEdit.WMMouseClick(var Msn: TMessage);
begin
  inherited;
  if assigned(FOnClick) then FOnClick(Self);
  FEdEingabe.Visible := true;
  FLblAnzeige.Visible := false;
end;

// Wenn die Maus über dem Label ist, ändert sich der Cursor, damit erkannt werden
// kann, dass man hier eine Eingabe tätigen kann.
procedure TLabEdit.CMMouseOver(var Msn: TMessage);
begin
  Cursor := crHandPoint;
end;
// Cursor wird auf den normalen Default-Cursor zurück gesetzt.
procedure TLabEdit.CMMouseLeave(var Msn: TMessage);
begin
  Cursor := crDefault;
end;

{////////////////////////////////////////////////////////////////////////////////////}
{/                               CreateWnd-Funktion                                 /}
{////////////////////////////////////////////////////////////////////////////////////}

procedure TLabEdit.CreateWnd;
begin
  inherited createwnd;
  FLblAnzeige := CreateLabel(3, 3, 18, FsTextWert, true);
  FLblAnzeige.OnClick := FLblOnClick;
  FEdEingabe := CreateEdit(0,0, FLblAnzeige.Width + 20, FLblAnzeige.Height, FLblAnzeige.Font.Height, FLblAnzeige.Caption, false);
  FEdEingabe.OnKeyDown := FEdKeyDown;
  ChangeEmbeddedEdit;
end;

end.
Ok der große Fehler ist im Getter für Visible und Enabled zu finden. Wenn ich die beiden Zeilen bei mir aktiviere, dann kann ich die Komponente compilieren und installieren, sie liegt auch in meiner Toolpalette aber wenn ich die Komponente dann auf die Form ziehe, hängt Delphi ganz kurz und verabschiedet (schließt sich) ohne eine Fehlermeldung. Obwohl in der Create-Funktion in der gleichen Art und Weise auf diese beiden Eigenschaften zugegriffen wird. Warum?

die kleinen Fehler, wie gesagt eigentlich banal: 1.) Ich würde eigentlich an Stelle des Hallos wieder die übliche Bezeichnung "TLabEdit1" sehen, wenn die Komponente auf die Form gezogen wird. 2.) Die Property MaxLength ist trotz deklaration in der Komponente nicht im Objektinspektor zu finden. Warum?
2. Account Sero
  Mit Zitat antworten Zitat