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?

[Luckie]

Ehm - wo Fehler?

[Leuselator]

Meine Frage Mensch!
Im Ernst: ich habe das ganze Thema Botschaftsverarbeitung noch nicht wirklich durchgeholt - sind so meine ersten Schritte was das angeht.

Und da ich dort mit WndProc rummache, denke ich das dort irgendwo der Hase im Strassengraben liegt.

Die Componente steckt in einem Package mit etwa 20 anderen. Aber nur, wenn ich so ein "TLsLabel" in einem Formular benutze, schmiert mir der ganze Schoiss ab. Nicht zur Laufzeit - da schnuckelt alles aber beim Beenden des Programmes kommt:

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

Danach hilft nur Delphi-Task abschießen, Delphi neu starten, weiter an dem Scheissding rumschrauben, und dto.

[Luckie]

Ich meine, du setzt uns hier ein Codemonster mit 185 Zeilen vor die Nase und sagst uns nur, dass irgendwo ein ein Fensterhandle nicht mehr gültig ist. Dann verlangst du von uns, ohne nähere Beschreibung deiner seits, dass wir dir die Zeile mit dem Fehler sagen. Was erwartest du?

Es bedarf wohl shcon alleine eine Stunde Einarbeit um deien Klasse zu verstehen und zu kucken, was wo passiert. Mit kommentaren warst du ja auch nicht gerade verschwenderisch.

Und erst jetzt, wenn man dir mal einen Stubs gibt rückst du mal mit etwas Infos raus, wie sich der Fehler äußert. Also das kann es ja wohl nicht sein oder?

[Leuselator]

@Lucky: Sorry!
1. Habe das Ding schon furchtbar eingeschmolzen, sind im Original knapp
1000 Zeilen. Hatte befürchtet, das noch mehr Comments zu sehr
aufblähen.
2. ich verlange nichts.
3. ich hoffe nur :-)
4. werde mich für Hilfe erkenntlich zeigen.

Hier nun noch mehr Info:

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. Hätte das besser gleich geschrieben, aber war mit Darstellung der Componente zu sehr abgelenkt.

Me absolves?

[Luckie]

Setz das mal vor deinen eigenen Code.

Allerdings, auskennen tue ich mich mit der Komponenten-Entwicklung auch nicht.

Übrigens, deine Ccodeformatierung ist auch recht eigenwillig. Lies dir mal bei Gelegenheit das: http://www.luckie-online.de/artikel/opstyleguide.shtml durch.

[kiar]

rufe mal zum schluß deiner mywndproc inherited auf.

vielleicht hilft dies schon.

@luckie ich wollt es lesen, hatte aber ne andere fremdsprache

[Leuselator]

Also mir ist nach dem 5. Tag der Blitz ins Hirn gefahren und ich denke, die Nummer ist gelöst.

Ich vermute (mir fehlt die Zeit das zu verifizieren), dass die Nummer mit dem übermalen des Associate-Controls zu endlosen Aufrufen von WM_Paint und WndProc, erst des Associates und dann wieder meines Labels geführt hat und beim Zerstören des Formulars ich irgendwo ein Paint, inherited Paint oder weis der Kuckuk was, aufgerufen habe, obwohl das Handle dafür schon ungültig war.

Die retttende Idee scheint mir folgende gewesen zu sein: ich erzeuge einfach eine Region für das Associate, die dessen Höhe um 1-2 Pixel beschneidet. Dadurch fühlt es sich nicht mehr von meiner Komponente übermalt, was zumindest das WM_Paint-Gewitter schonmal drastisch reduziert hat.

Werde das ganze nun rund machen und mich dann nochmal melden, wenn es funzt.

GreetsToAll

[Luckie]

Also wenn du WM_PAINT bearbeitest, dann mußt du zwingend deinen Code in ein BeginPaint und EndPaint packen, damit Windows weiß, dass dein Fenster wieder aktuell ist, sonst schickt es andauernd weiter ein WM_PAINT an dein Fenster.

Also:

Delphi-Quellcode:

case Msg of
  WM_PAINT:
    begin
      BeginPaint();
      EndPaint();
     end;
end;