Event bei Z-Order Änderung o.ä.

[Medium]

Aber gerade wenn ich die Z-Order ändere wird doch ein Neuzeichnen ausgelöst. Mache ich das also im Paint, löse ich wieder ein Paint aus, unabhängig davon ob das Neuordnen notwendig war oder nicht. Ein Mal reicht, und ich hänge in der Schleife fest.

Warum mit Labels? Es geht um eine Balkenanzeige, die Skalen links und oder rechts bzw. oben/unten hat. Die Skalengrenzen (Minimum/Maximum) werden zur Laufzeit aus einer DB versorgt, d.h. ich weiss zur Designtime nicht, wie breit mein Text werden wird. Ich möchte aber meine Balken am Rest auf der Form ausrichten, und zwar wirklich pixelgenau mit dem Balken. Dessen Breite/Höhe würde sich ja sonst verändern. (Vorher war es genau so, jetzt kam aber die Versorgung der Min/Max zur Laufzeit hinzu, womit das auf ein Mal Thema wurde.)

Ebenso haben die Balken eine Anzeige des aktuellen Wertes als Zahl. Dessen Position kann allseitig des Balkens sein, oder aber auch darin zentriert. Auch hier wurde es ein Label, da bei Platzierung ausserhalb des Balkens der Balken selbst nicht in seiner Größe geändert werden darf. Und das Problem dass ich habe manifestiert sich nun bei diesem Label, wenn es auf dem Balken zentriert dargestellt wird: Balken.BringToFront -> Label ist auf ein Mal hinten.

[Bummi]

Cih wollte gerade keine Komponente schreiben, die Simulation hier mit Paintbox und Label überlappend sollte sich IMHO aber identisch verhalten.

Delphi-Quellcode:

Function ZOrderFirst(TestComp,MainComponent:TControl):Boolean;
var
 i:Integer;
 p:TWinControl;
 found:Boolean;
begin
   found := false;
   p := Maincomponent.Parent;
   if not assigned(p) then Exit;

   for i  := 0 to p.Controlcount - 1 do
     begin
       if (p.Controls[i]= TestComp) or (p.Controls[i]= MainComponent) then
        begin
          Result := p.Controls[i]= TestComp;
          break;
        end;
     end;

end;

procedure TForm5.Button1Click(Sender: TObject);
begin
  Paintbox1.BringToFront;
end;

procedure TForm5.Button2Click(Sender: TObject);
begin
  Label1.BringToFront;
end;

procedure TForm5.PaintBox1Paint(Sender: TObject);
var
 c:TCanvas;
begin

  c := TPaintBox(sender).Canvas;
  c.Brush.Color := clBlue;
  c.Ellipse(TPaintBox(sender).ClientRect);
  if  ZOrderFirst(Label1,TPaintBox(sender)) then
    begin
     Label1.BringToFront;
    end;
end;

[Sir Rufo]

@Bummi

Eigentlich könnte man nach dem Label1.BringToFront die OnPaint Methode verlassen, denn es wird ja direkt neu gezeichnet.

@Medium

Wenn der Z-Index nicht stimmt, dann muss neu gezeichnet werden. Das wird ja auch durch das Umordnen provoziert.
Wenn der Z-Index stimmt, dann wird nichts umgeordnet und damit auch kein Neuzeichnen provoziert.

So undeutlich schreiben wir doch gar nicht

[DeddyH]

Du durchläufst p.ControlCount (Parent-Beziehung) und greifst dann auf p.Components (Owner-Beziehung) zu. Ist das Absicht?

[Sir Rufo]

Zitat von DeddyH:

Du durchläufst p.ControlCount (Parent-Beziehung) und greifst dann auf p.Components (Owner-Beziehung) zu. Ist das Absicht?

Wohl eher absichtlich unabsichtlich vertippt.

[DeddyH]

Das kann aber fatal enden, deshalb meine Frage

[Bummi]

@DeddyH , nein , danke für den Hinweis, habe es korrigiert.

[Bummi]

@Sir Rufo

Zitat:

Eigentlich könnte man nach dem Label1.BringToFront die OnPaint Methode verlassen

ich hatte kurz über diese Option nachgedacht, dann aber beschlossen sicherheitshalber in jedem Fall zeichnen zu lassen, für den Fall dass das Label kein intersect mit dem control hat, das Label in der zOrder tiefer liegt und erstmalig gezeichnet wird.

[Medium]

Problem gelöst! Allerdings ein Eckchen aufwendiger

Zu erreichen war ja, dass meine Sub-Controls in Z-Richtung immer möglichst nahe an meinem eigentlichen Control (Balken) liegen, zumindest aber so, dass folgendes gewährleistet ist:
- alle Lables müssen immer über dem Balken liegen
- alle Controls, die den Balken verdecken, sollen auch die Labels verdecken
- alle Controls, die durch den Balken verdeckt werden, sollen auch hinter den Labels liegen

Letztlich also so, als wären die Labels (und Skalenstriche, die ich ebenfalls als Subkomponente gebaut habe weil sie ausserhalb liegen sollen) fester Bestandteil des Balkens, und lägen in der selben Z-Plane wie dieser.

Ärgerlich ist mal wieder, dass CodeGear (ja, D2007 ) ja recht freizügig mit private-Deklarationen in der VCL war. Um o.g. zu erreichen, wäre die Methode TControl.SetZOrderPosition() ideal gewesen, aber eben leider private. Gut, kann man sich abgucken und kopieren, aber leider ist auch das darin benötigte Feld "FControls", sowie die Methode InvalidateControl() private. Und die Methode PaletteChanged() ist protected
Also musste ein ekeliger Hack her, womit das ganze erstmal nur gesichert in meiner Version klappt. Das ist zunächst auch okay, weil wir D2007 hier überall haben, und die Komponente nur für den hausinternen Gebrauch ist. Lange Rede, kurzer Pin: Die Hack-Klasse:

Delphi-Quellcode:

type
  // Liegt in der selben Unit wie TKATBalken, wodurch dank Friend-Beziehung Zugriff auf private Felder geht
  // Feld-Layout ist identisch mit dem von TWinControl
  THackedControl = class(TControl)
  private
    FAlignLevel: Word;
    FBevelEdges: TBevelEdges;
    FBevelInner: TBevelCut;
    FBevelOuter: TBevelCut;
    FBevelKind: TBevelKind;
    FBevelWidth: TBevelWidth;
    FBorderWidth: TBorderWidth;
    FPadding: TPadding;
    FBrush: TBrush;
    FDefWndProc: Pointer;
    FDockClients: TList;
    FDockManager: IDockManager;
    FHandle: HWnd;
    FImeMode: TImeMode;
    FImeName: TImeName;
    FObjectInstance: Pointer;
    FParentWindow: HWnd;
    FTabList: TList;
    FControls: TList;
    FWinControls: TList;
    FTabOrder: Integer;
    FTabStop: Boolean;
    FCtl3D: Boolean;
    FShowing: Boolean;
    FUseDockManager: Boolean;
    FDockSite: Boolean;
    FParentCtl3D: Boolean;
    FOnDockDrop: TDockDropEvent;
    FOnDockOver: TDockOverEvent;
    FOnEnter: TNotifyEvent;
    FOnExit: TNotifyEvent;
    FOnGetSiteInfo: TGetSiteInfoEvent;
    FOnKeyDown: TKeyEvent;
    FOnKeyPress: TKeyPressEvent;
    FOnKeyUp: TKeyEvent;
    FOnUnDock: TUnDockEvent;
    FOnAlignInsertBefore: TAlignInsertBeforeEvent;
    FOnAlignPosition: TAlignPositionEvent;
    FMouseInClient: Boolean;
    FMouseControl: TControl;
  public
    function PaletteChanged(Foreground: Boolean): Boolean; override;
  end;

implementation

function THackedControl.PaletteChanged(Foreground: Boolean): Boolean;
begin
  result := inherited PaletteChanged(Foreground);
end;

Dann waren InvalidateControl() und SetZOrderPosition() zu re-implementieren, und zwar so, dass es als Prozedur/Funktion geht, nicht Methode:

Delphi-Quellcode:

procedure InvalidateControl(IsVisible, IsOpaque: Boolean; self: TControl; aParent: THackedControl);
var
  Rect: TRect;

  function BackgroundClipped: Boolean;
  var
    R: TRect;
    List: TList;
    I: Integer;
    C: TControl;
  begin
    Result := True;
    List := aParent.FControls;
    I := List.IndexOf(Self);
    while I > 0 do
    begin
      Dec(I);
      C := List[I];
      with C do
        if C.Visible and (csOpaque in ControlStyle) then
        begin
          IntersectRect(R, Rect, BoundsRect);
          if EqualRect(R, Rect) then Exit;
        end;
    end;
    Result := False;
  end;

begin
  if (IsVisible or (csDesigning in self.ComponentState) and
    not (csNoDesignVisible in self.ControlStyle)) and (self.Parent <> nil) and
    self.Parent.HandleAllocated then
  begin
    Rect := self.BoundsRect;
    InvalidateRect(self.Parent.Handle, @Rect, not (IsOpaque or
      (csOpaque in self.Parent.ControlStyle) or BackgroundClipped));
  end;
end;

procedure SetZOrderPosition(Position: Integer; self: TControl; aParent: THackedControl);
var
  I, Count: Integer;
  ParentForm: TCustomForm;
begin
  if aParent <> nil then
  begin
    I := aParent.FControls.IndexOf(Self);
    if I >= 0 then
    begin
      Count := aParent.FControls.Count;
      if Position < 0 then Position := 0;
      if Position >= Count then Position := Count - 1;
      if Position <> I then
      begin
        aParent.FControls.Delete(I);
        aParent.FControls.Insert(Position, Self);
        InvalidateControl(self.Visible, True, self, aParent);
        if not (csLoading in self.ComponentState) then
        begin
          ParentForm := ValidParentForm(Self);
          if csPalette in ParentForm.ControlState then
            THackedControl(ParentForm).PaletteChanged(True);
        end;
      end;
    end;
  end;
end;

Und dann meine Helfer-Methoden:

Delphi-Quellcode:

function GetControlParentIndex(aControl: TControl): Integer;
var
  i: Integer;
begin
  result := -1;
  if not Assigned(aControl.Parent) then Exit;
  for i := 0 to aControl.Parent.ControlCount-1 do
  begin
    if aControl.Parent.Controls[i] = aControl then
    begin
      result := i;
      Exit;
    end;
  end;
end;

function RectsOverlap(aRect1, aRect2: TRect): Boolean;
begin
  result := not((aRect1.Right < aRect2.Left) or (aRect1.Left > aRect2.Right) or (aRect1.Bottom < aRect2.Top) or (aRect1.Top > aRect2.Bottom));
end;

procedure TKATBalken.CorrectSubControlZOrder(aSubControl: TControl; aBaseIndex: Integer);
var
  i, subIndex: Integer;
begin
  subIndex := GetControlParentIndex(aSubControl);
  if subindex<0 then Exit;

  if subIndex<aBaseIndex then
  begin
    SetZOrderPosition(aBaseIndex+1, aSubControl, THackedControl(Parent));
  end
  else
  begin
    for i := 0 to Parent.ControlCount-1 do
    begin
      if RectsOverlap(Parent.Controls[i].BoundsRect, aSubControl.BoundsRect) then
      begin
        if ((i>aBaseIndex) and (i<subIndex)) or ((i<aBaseIndex) and (i>subIndex)) then
        begin
          SetZOrderPosition(aBaseIndex+1, aSubControl, THackedControl(Parent));
          Exit;
        end;
      end;
    end;
  end;
end;

procedure TKATBalken.CorrectZOrders;
var
  i, selfIndex: Integer;
begin
  selfIndex := GetControlParentIndex(self);
  CorrectSubControlZOrder(ValueLabel, selfIndex);
  CorrectSubControlZOrder(ScaleLeft, selfIndex);
  CorrectSubControlZOrder(ScaleRight, selfIndex);
  for i := 0 to High(ScaleLabelsLeft) do
  begin
    CorrectSubControlZOrder(ScaleLabelsLeft[i], selfIndex);
    CorrectSubControlZOrder(ScaleLabelsRight[i], selfIndex);
  end;
end;

procedure TKATBalken.Paint;
begin
  inherited;
  CorrectZOrders;
  // Restlicher Code...

Mit "CorrectZOrders" werden dann genau die o.g. Bedingungen hergestellt. Vor allem aber wird nichts geändert wenn diese schon bestehen, so dass dies nicht mehr zu einer Endlosrekursion wird. Zwar finde ich das ganze im Paint noch immer deutlich zu oft, zumal dann ja zumindest immer noch die Prüfungen laufen, aber es scheint einfach keine bessere Stelle zu geben. Läuft prima, auch auf ziemlich gut gefüllten Forms!

Danke nochmals an alle

[Medium]

Hui, das schaut nett aus. Ich glaube, ich hatte auch einen halben Meter zu kurz gedacht vorhin. Schade, dass Komponenten nicht standardmäßig ihren Index in der Parent-Liste bei sich tragen, weil so muss ich teilweise eine ganze Menge durchnudeln um es zu finden, was in jedem Repaint irgendwie unschön aussieht. Praktisch dürfte das glaube ich aber kaum zu merken sein. Probier ich morgen mal umzusetzen, danke!

Nebenfrage:
Die Labels werden mit der Balken-Komponente als Owner erstellt, und bekommen dann den Parent der Balken-Kompo selbst auch als Parent. Tauchen die dann überhaupt in der Controls- bzw. Components-Liste des Formulars auf?

Edit: Rote Box - das sollte diese Frage beantwortet haben