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
"When one person suffers from a delusion, it is called insanity. When a million people suffer from a delusion, it is called religion." (Richard Dawkins)