Vega — Eigene Steuerelemente

Reicht der Vorrat nicht, baut man sich eins. Ein eigenes Steuerelement ist eine Klasse, die von TControl erbt: Zustand als Felder, Darstellung in Paint, Bedienung in den Do*-Methoden. Mehr Mechanik gibt es nicht — dieselbe, die alle mitgelieferten Elemente benutzen.

→ Vega-Guides · Zeichnen · Themes

pub type TMeins = class extends TControl {
    Wert: int64;                       // eigener Zustand

    fn Create(): void {
        self.Init();                   // IMMER zuerst
        self.Wert := 0;
        self.Height := 28;
        self.CanFocus := true;
    }

    override fn Paint(canvas: TCanvas): void { … }
    override fn DoMouseDown(x: int64, y: int64, button: int64): void { … }
}

pub fn NewMeins(): TMeins { return new TMeins(); }

self.Init() setzt die Vorgaben von TControl — ohne diesen Aufruf sind Sichtbarkeit, Farben und Zustandsfelder undefiniert.

Die Do*-Methoden sind der Weg für eingebautes Verhalten, die On*-Felder der Weg für die Anwendung. Ein eigenes Element bedient beides: Es reagiert selbst (Griff verschieben) und meldet die Änderung nach außen (OnChange).

unit Main;

import std.io;
import Vega.Types;
import Vega.Events;
import Vega.Canvas;
import Vega.Theme;
import Vega.Control;
import Vega.Font;
import Vega.Strings;
import Vega.Lists;
import Vega.Style;
import Vega.StdCtrls;
import Vega.Backend;
import Vega.BackendAuto;
import Vega.Forms;

var g_app: TApplication;
var g_anzeige: TLabel;

// Ein eigenes Steuerelement: waagerechter Schieberegler.
// Zustand als Felder, Darstellung in Paint, Bedienung in den Do*-Methoden.
pub type TRegler = class extends TControl {
  Wert: int64;          // 0..100
  Ziehen: bool;
  OnChange: TNotifyEvent;

  fn Create(): void {
    self.Init();                 // IMMER zuerst: setzt die Vorgaben von TControl
    self.Wert := 50;
    self.Ziehen := false;
    self.Height := 28;
    self.CanFocus := true;       // nimmt Tastatureingaben an
    self.TabStop := true;
  }

  fn SetWert(v: int64): void {
    var n: int64 := v;
    if (n < 0) { n := 0; }
    if (n > 100) { n := 100; }
    if (n == self.Wert) { return; }
    self.Wert := n;
    self.Invalidate();                                  // Setter zeichnet neu
    if (self.OnChange != 0) { self.OnChange(self as TControl); }
  }

  // Wert aus einer x-Position im Control
  fn WertAus(x: int64): int64 {
    var w: int64 := self.Width - 8;
    if (w <= 0) { return 0; }
    return ((x - 4) * 100) / w;
  }

  override fn Paint(canvas: TCanvas): void {
    var r: TRect := self.ClientRect();
    canvas.FillRect(r, RGB(240, 240, 240));
    canvas.FrameRect(r, RGB(150, 150, 150));

    // Rille
    var mitte: int64 := RectHeight(r) / 2;
    canvas.FillRect(Rect(4, mitte - 2, RectWidth(r) - 4, mitte + 2), RGB(200, 200, 200));

    // Griff — Farbe zeigt Fokus und Ziehen
    var gx: int64 := 4 + (self.Wert * (RectWidth(r) - 8)) / 100;
    var farbe: TColor := RGB(70, 130, 180);
    if (self.Hovered) { farbe := RGB(90, 150, 200); }
    if (self.Ziehen)  { farbe := RGB(40, 90, 140); }
    canvas.FillRoundRect(Rect(gx - 5, 3, gx + 5, RectHeight(r) - 3), 3, farbe);
    if (self.Focused) { canvas.FrameRect(r, RGB(70, 130, 180)); }
  }

  override fn DoMouseDown(x: int64, y: int64, button: int64): void {
    self.Ziehen := true;
    self.SetWert(self.WertAus(x));
  }

  override fn DoMouseMove(x: int64, y: int64, button: int64): void {
    if (self.Ziehen) { self.SetWert(self.WertAus(x)); }
  }

  override fn DoMouseUp(x: int64, y: int64, button: int64): void {
    self.Ziehen := false;
    self.Invalidate();
  }

  override fn DoKeyDown(key: int64, modifiers: int64): void {
    if (key == KEY_LEFT)  { self.SetWert(self.Wert - 1); }
    if (key == KEY_RIGHT) { self.SetWert(self.Wert + 1); }
    if (key == KEY_HOME)  { self.SetWert(0); }
    if (key == KEY_END)   { self.SetWert(100); }
  }

  override fn DoMouseWheel(delta: int64): void {
    self.SetWert(self.Wert + delta * 5);
  }
}

pub fn NewRegler(): TRegler { return new TRegler(); }

fn OnReglerAenderung(sender: TControl): void {
  var r: TRegler := sender as TRegler;
  g_anzeige.SetCaption(StrConcat("Wert: ", IntToStr(r.Wert)));
}

fn OnBeenden(sender: TControl): void { g_app.Terminate(); }

fn main(): int64 {
  g_app := new TApplication(NewPlatformBackend());
  if (!g_app.Ready) { PrintLn("Kein Fenstersystem erreichbar."); return 1; }

  var f: TForm := new TForm(360, 180, "Eigenes Steuerelement");

  g_anzeige := new TLabel("Wert: 50");
  g_anzeige.SetBounds(16, 16, 200, 18);
  g_anzeige.SetParent(f);

  var reg: TRegler := NewRegler();
  reg.SetBounds(16, 48, 320, 28);
  reg.OnChange := OnReglerAenderung;
  reg.SetParent(f);

  var b: TButton := new TButton("Beenden");
  b.SetBounds(216, 110, 120, 28);
  b.OnClick := OnBeenden;
  b.SetParent(f);

  if (!g_app.ShowForm(f)) { return 2; }
  f.Dispatcher.SetFocus(reg as TControl);
  g_app.Run();
  g_app.Shutdown();
  return 0;
}

Übersetzen: lyxc regler.lyx -I . -I platform/linux -o regler. Nachgemessen mit lyxc 1.1.3I, übersetzt fehlerfrei.

1. self.Init() als erste Zeile im Create.
2. Paint rechnet nicht, es zeichnet. Alles, was aus Ereignissen kommt, steht vorher in Feldern.
3. Setter statt nackter Felder. SetWert begrenzt den Bereich, zeichnet neu und ruft OnChange — wer reg.Wert := 200 schreibt, umgeht all das. Genau dafür gibt es in Delphi property; hier ist es Disziplin.
4. Zustand nach außen melden. Ein Element ohne On*-Feld lässt sich nicht in eine Anwendung einbauen.
5. Nach jeder Änderung Invalidate() — am besten im Setter, dann kann es niemand vergessen.

Ein aufklappender Teil — eine Liste, ein Kalender — liegt unterhalb des Controls und damit außerhalb von ClientRect(). Klicks kommen dort trotzdem nicht an, solange der Treffertest sie nicht durchlässt:

• Vega.Dispatch fragt Root.HitTest(x, y).
• Die Basisfassung in Vega.Control beginnt mit if (!RectContains(self.ClientRect(), x, y)) { return null; }.

Ohne eigenes HitTest ist der Auswahlpfad im aufgeklappten Teil also toter Code — er sieht richtig aus, wird aber nie erreicht. Das Muster:

override fn HitTest(x: int64, y: int64): TControl {
  if (!self.Visible) { return null; }
  if (self.DroppedDown) {
    if (RectContains(self.DropRect(), x, y)) { return self as TControl; }
  }
  return super.HitTest(x, y);
}

So arbeiten TDateTimePicker und TComboBox. Menüs sind nicht betroffen: sie laufen über TForm.ActivePopup und das Overlay, nicht über den Treffertest.

Geometrie nur einmal ausrechnen. DropRect() gehört in eine Methode, die Zeichnen und Treffertest fragen. Zwei getrennte Rechnungen für dasselbe Rechteck laufen früher oder später auseinander — dann trifft der Klick eine andere Zeile als die, die unter dem Zeiger steht.

Wer sein Element themefähig machen will, holt die Farben aus dem Stylesheet statt sie festzuschreiben:

self.StyleType := StyleRegistry().TypeId("meins");   // im Create
…
var st: TStyleSet := self.ResolvedStyle();           // im Paint
canvas.FillRect(r, st.GetOr(SP_BACKGROUND, self.Color));
st.Destroy();

Zusätzlich meldet override fn StyleStates(), welche Zustände gerade gelten (ST_CHECKED, ST_HOVER …) — damit greifen Regeln wie checked { … } aus einem .vtheme auch am eigenen Element. Einzelheiten in der Themes-Referenz.

• self.Init() vergessen. Das Element verhält sich zufällig — Sichtbarkeit und Zustandsfelder sind nicht gesetzt.
• CanFocus nicht gesetzt, aber DoKeyDown überschrieben: Es kommen nie Tasten an.
• Direkt in Width/Height gerechnet statt in ClientRect() — dann zeichnet man über den Rahmen.
• Kein Invalidate nach der Zustandsänderung: Das Bild bleibt stehen.
• Über die eigenen Grenzen gezeichnet, ohne HitTest zu überschreiben — siehe oben; der Klick kommt nie an.
• Dieselbe Geometrie an zwei Stellen gerechnet (Zeichnen und Treffertest): Sie laufen auseinander, sobald sich eine der beiden ändert.
• DoAccept auf einem TMonthCalendar gerufen — die Methode gibt es nicht. Die Wahl kommt über Doppelklick oder KEY_RETURN, beides feuert OnAccept.
• Inline-Array von Kindern ([N]TControl) — hielt bis lyxc 1.1.2G Kopien statt Referenzen (#1646); TObjectList ist der ruhigere Weg.

Letzte Aktualisierung: 2026-08-20 — überschreibbare Methoden aus Vega/Control.lyx erhoben; Beispiel mit lyxc 1.1.3I übersetzt, der HitTest-Abschnitt gegen Vega/DateTimePicker.lyx und Vega/ListCtrls.lyx (Stand 2026-08-20) geprüft.