Component mit assoz. Component - drehe langsam frei...

[Leuselator]

Hi Leutz,
habe (wie ich meinte) nette kleine Componente gebastelt, die sich an andere Componenten "anhängt" - 'n Label halt. Der Gag sollte sein, dass es das Control, an welches es sich anhängt teilweise "übermalt", so dass das ganze Gespann dann wie aus einem Guss ausschaut.

seit einiger Zeit (3Tage) bekomme ich nun böse Abstürze mit der Meldung:

Zitat:

Fehler
Im Projekt XYZ.exe ist eine Exception der Klasse EWin32Error aufgetreten. Meldung: 'Win32-Fehler. Code 1400.
Ungültiges Fensterhandle'.

nach 4 Tagen würde ich denjenigen, der mir auf's Pferd hülft, an hervorragender Stelle in mein Abendgebet einschliessen.

TLsLabel "hängt" an TPanel. Auf TPanel ist ein Control.
beim durch-steppen mit F7 knallt es im 'inherited Destroy' des Controls auf dem TPanel. Lasse ich das TLsLabel weg, ist alles schön.
Mehr weiss ich selbst leider auch nicht.
Der Deliquent:

Delphi-Quellcode:

  TLsWndMethod = procedure(var Message: TMessage) of object;

  TLsLabel = class(TCustomControl)
  private
    FControl          : TWincontrol;
    FLsWndMethod      : TLsWndMethod;
    DieRegion         : HRGN;
  // ...
  protected
  // ...
    procedure Paint;  override;
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
    procedure SetControl(Value: TLsParent);
    procedure Notification(AComponent : TComponent;
                           Operation  : TOperation); override;
  // ...
    procedure MyWndProc(Var Message : TMessage);
    procedure MakeRegion(RepaintIt : Boolean);
  public
    constructor create(AOwner : TComponent); override;
    destructor destroy; override;
  published
    property Associate : TLsParent read FControl write SetControl;
  // ...
  end;

implementation

constructor TLsLabel.Create(AOwner : TComponent);
begin
  inherited create(AOwner);
  if (AOwner is TWincontrol) 
    then Parent := TWincontrol(AOwner);
  FLsWndMethod := nil;
  FControl     := nil;
  SP; // Setzt Array "DiePunkte" in Abhängigkeit der Position am
      // Verlinkten Control - hat 6 Punkte, sieht etwa so aus:
      // 1| --------------------------------------------------# 6
      //  |                     ############################### 5
      //  |  LabelText         # 4
      //  |                   #
      //  |                  #
      // 2 ################## 3
  DieRegion:= CreatePolygonRgn(DiePunkte,6,ALTERNATE);
  SetWindowRgn(Handle, DieRegion, True);
  OldW := self.Width;
  OldH := self.Height;
  IsSetting := False;
end;

destructor TLsLabel.Destroy;
begin
  FCaptionFont.Free;
  IF  Assigned(FControl)
    and Assigned(FLsWndMethod)
    then TWinControl(FControl).WindowProc := FLsWndMethod;
  FLsWndMethod := nil;
  inherited destroy;
end;

procedure TLsLabel.SetControl(Value: TLsParent);
var i : integer;
   ControlFound : Boolean;
   AlterAssociate : TLsParent;
   AltesControl : TWincontrol;
   AlteWinMet : TLsWndMethod;
begin
  if Value <> FControl then 
  begin
    if not Assigned(Value) then 
    begin
      if Assigned(FControl) then 
      begin
        TWinControl(FControl).WindowProc := FLsWndMethod;
        FLsWndMethod := nil;
      end;
      FControl := Value;
      FCaption := 'Bin Einsam!';
    end else 
    begin
      if Assigned(FControl) then begin
        TWinControl(FControl).WindowProc := FLsWndMethod;
        FLsWndMethod := nil;
      end;
      FControl := Value;
      Parent   := FControl.Parent;
      Left     := FControl.Left;
      Width    := FControl.Width;
      Top      := FControl.Top+FControl.Height-2; // wie gesagt,
                                                  // es ragt hinein
      FLsWndMethod := TWincontrol(FControl).WindowProc;
      TWincontrol(FControl).WindowProc := MyWndProc;
      TWinControl(FControl).SendToBack;
    end;
  end;
  if Assigned(FControl) then Paint;
end;

procedure TLsLabel.MyWndProc(Var Message : TMessage);
begin
  if Assigned(FControl) and not 
    (csDestroying in  TWincontrol(FControl).ComponentState) and not
    (csDestroying in self.ComponentState)
    then 
  begin
    if  (Message.Msg in [WM_PAINT,
                         WM_SHOWWINDOW,
                         WM_WINDOWPOSCHANGED,
                         WM_SIZE,
                         WM_MOVE,
                         WM_WINDOWPOSCHANGING]) and not 
      IsSetting
      then 
    begin
      IsSetting := True;
      Left      := FControl.Left;
      Width     := FControl.Width;
      Top       := FControl.Top+FControl.Height-2;
    end;
    if Assigned(FLsWndMethod) 
      then FLsWndMethod(Message);
    IsSetting := False;
    Invalidate;
  end;
end;

procedure TLsLabel.WMPaint(var Message: TWMPaint);
begin
  if not IsSetting 
    then 
  begin
    if (self.Width <> OldW) or (self.Height <> OldH) 
      then 
    begin
      OldW := self.Width;
      OldH := self.Height;
      IsSetting := True;
      MakeRegion(True); // löscht das RegionObjekt,
                        // und setzt neue Region
                        // ruft Paint auf
      IsSetting := False;
    end;
  end;
  if Message.Msg <> WM_WINDOWPOSCHANGED then inherited;
  Paint;
end;

procedure TLsLabel.MakeRegion(RepaintIt : Boolean);
begin
  DeleteObject(DieRegion);
  if FCaptionVisible then 
  begin
    SP; // setzt DiePunkte neu
    DieRegion:= CreatePolygonRgn(DiePunkte,6,ALTERNATE);
    SetWindowRgn(Handle, DieRegion, RepaintIt);
  end else 
  begin
    DieRegion:= CreateRectRgn(0,0,Width,Height);
    SetWindowRgn(Handle, DieRegion, RepaintIt);
  end;
  Paint;
end;

procedure TLsLabel.Notification(AComponent : TComponent; Operation : TOperation);
begin
  if (    (FControl   <> nil) and 
     (AComponent  = TComponent(FControl)) and 
     (Operation   = opRemove)) 
     then
  begin
    FControl := nil;
    if not (csDestroying in Componentstate) 
      then
    begin
      FCaption := 'Bin Einsam!';
      Paint;
    end;
  end;
end;

procedure TLsLabel.Paint;
begin
  ExistControl := Assigned(FControl);
  inherited paint;
  if HasParent 
    then 
  begin
    Canvas.Brush.Color := FCaptionColorBack;
    Canvas.FillRect(GR(0));             // GR liefert TRect
    Canvas.Pen.Style := psClear;
    Canvas.Pen.Color := GF(0);          //GF liefert TColor
    Canvas.MoveTo(GP('A').x,GP('A').y); //GP liefert TPoint
    Canvas.LineTo(GP('B').x,GP('B').y);
    Canvas.Brush.Style := bsClear;
    Canvas.Font.Color  := FCaptionColorFront;
    Canvas.Pen.Color   := FCaptionColorFront;
    Canvas.TextRect(GR(1),GP('I').x,GP('I').y,FCaption);
    Canvas.Brush.Style := bsSolid;
    Canvas.Pen.Color := GF(1);
    Canvas.MoveTo(GP('C').x,GP('C').y);
    Canvas.LineTo(GP('D').x,GP('D').y);
    //... usw. Malen halt - nix sonst
  end;
end;

Ehm - Hilfe?