// Dieser Code dient der Erstellung einer Label-Komponente mit zusätzlichen
// Eigenschaften. Wird diese Komponente zur Laufzeit angeklickt oder vom
// Programm mittels der Funktion "Wechsel" angesteuert, markiert bzw.
// demarkiert sie sich selbst. Die Art der Markierung (z.B. Rahmen) wird
// durch die zusätzlichen Eigenschaften festgelegt.
// Siehe dazu auch eine Labelkomponente für Links erstellen

  {Erläuterung der neuen Eigenschaften siehe unten}

// Getestet mit D4 unter Win98

unit NeuLabel; 
 
interface 
 
uses 
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
  StdCtrls; 
 
type 
  klickart = (AnyClick, WithDelay, OnlyDblClick); 
  randart = (IfSelected, Always, Never); 
  erlaubnis = (Both, Clicking, Externally, No); 
  angefordert = (NotYet, ByClicking, FromProgram); 
 
  TNeuLabel = class(TLabel) 
  private 
    ow: TNotifyEvent; 
    genehmigt: erlaubnis; 
    markiert: boolean; 
    wer: angefordert; 
    intern: byte; 
    rand: randart; 
    art: klickart; 
    fontco, untco, auswfontco, auswuntco, rcolor: TColor; 
  protected 
    procedure Click; override; 
    procedure DblClick; override; 
    procedure setauswahlschrift(f: TColor); 
    procedure setauswahlflaeche(f: TColor); 
    procedure setrahmenfarbe(f: TColor); 
    procedure setrand(r: randart); 
  public 
    constructor Create(Owner: TComponent); override; 
    procedure paint; override; 
    function wechsel: boolean; 
    property Selected: boolean read markiert; 
    property LastRequest: angefordert read wer; 
  published 
    property Reaction: klickart read art write art; 
    property Background: TColor read auswuntco write setauswahlflaeche; 
    property FontColor: TColor read auswfontco write setauswahlschrift; 
    property BorderColor: TColor read rcolor write setrahmenfarbe; 
    property Border: randart read rand write setrand; 
    property Permission: erlaubnis read genehmigt write genehmigt; 
    property OnModification: TNotifyEvent read ow write ow; 
  end; 
 
procedure Register; 
 
implementation 
 
constructor TNeuLabel.Create(Owner: TComponent); 
begin 
  inherited Create(Owner); 
  alignment := tacenter; 
  layout := tlcenter; 
  autosize := false; 
  auswfontco := clyellow; 
  auswuntco := clblack; 
  rcolor := claqua; 
end; 
 
procedure TNeuLabel.setauswahlflaeche(f: tcolor); 
begin 
  if f = auswuntco then exit; 
  auswuntco := f; 
  if markiert then color := auswuntco; 
end; 
 
procedure TNeuLabel.setauswahlschrift(f: tcolor); 
begin 
  if f = auswfontco then exit; 
  auswfontco := f; 
  if markiert then font.color := auswfontco; 
end; 
 
procedure TNeuLabel.setrahmenfarbe(f: tcolor); 
begin 
  if f = rcolor then exit; 
  rcolor := f; 
  if markiert then repaint; 
end; 
 
procedure TNeuLabel.setrand(r: randart); 
begin 
  if r = rand then exit; 
  rand := r; 
  repaint; 
end; 
 
function TNeuLabel.wechsel: boolean; 
begin 
  result := false; 
  if intern = 1 then begin wer := byclicking; 
    intern := 2; 
  end 
  else wer := fromprogram; 
  if (genehmigt = externally) and (intern = 2) then begin 
    intern := 0; 
    exit; 
  end; 
  if (genehmigt = no) or (genehmigt = clicking) and (intern <> 2) 
    then exit; 
  intern := 0; 
  if markiert then begin 
    markiert := false; 
    font.color := fontco; 
    color := untco; 
  end else begin 
    markiert := true; 
    untco := color; 
    fontco := font.color; 
    font.color := auswfontco; 
    color := auswuntco; 
  end; 
  result := true; 
  if assigned(onmodification) then onmodification(self); 
end; 
 
procedure TNeuLabel.click; 
begin 
  inherited; 
  if (art = onlydblclick) then exit; 
  intern := 1; 
  wechsel; 
end; 
 
procedure TNeuLabel.dblclick; 
begin 
  inherited; 
  if (art = withdelay) then exit; 
  intern := 1; 
  wechsel; 
end; 
 
procedure TNeuLabel.paint; 
begin 
  inherited; 
  if (rand = never) or (rand = ifselected) and (not markiert) then exit; 
  if enabled then begin 
    if markiert then canvas.pen.color := rcolor 
    else canvas.pen.color := font.color; 
  end else canvas.pen.color := clbtnshadow; 
  canvas.rectangle(0, 0, width, height); 
end; 
 
procedure Register; 
begin 
  RegisterComponents('DBR', [TNeuLabel]); 
end; 
 
end.

// -----------------------------------------------------------------
Neue Eigenschaften:

Reaction (AnyClick,WithDelay,OnlyDblClick)
Hiermit wird festgelegt, wie die Komponente auf das Anklicken reagiert.
AnyClick: Bei jedem Klick wird umgeschaltet (markiert <--> unmarkiert).
Das heißt, dass auch bei einem Doppelklick schnell hin und hergeschaltet
wird.
WithDelay: Die Komponente verzögert ihre Reaktion nach dem ersten Klick.
Damit fällt ein Doppelklick genauso aus wie ein einfacher.
OnlyDblClick: Die Komponente reagiert nur auf einen Doppelklick.

FontColor (TColor) 
Legt die Farbe der Schrift im markierten Zustand fest
Bitte nicht mit Font.Color verwechseln! Font.Color legt generell die
Schriftfarbe fest und überschreibt in markiertem Zustand temporär FontColor.

Background (TColor)
Legt die Farbe der Fläche im markierten Zustand fest
Diese Eigenschaft wird von "Color" in markiertem Zustand temporär
überschrieben. Bei Transparent=True ist der Farbwechsel logischerweise
nicht zu sehen.

BorderColor (TColor)
Bestimmt die Farbe des Rahmens in markiertem Zustand. 
In unmarkiertem Zustand nimmt der Rahmen die Farbe der Schrift an.

Border (IfSelected,Always,Never)
Legt fest, wann ein Rahmen gezeichnet wird.
IfSelected: Der Rahmen wird nur gezeichnet, wenn die Komponente markiert ist.
Always: Es wird immer ein Rahmen gezeichnet.
Never: Es wird nie ein Rahmen gezeichnet.

Permisson (Both,Clicking,Externally,No) 
Legt fest, ob und wodurch die Komponente angesteuert werden darf.
Both: Sowohl das Anklicken als auch der programmseitige Aufruf der Funktion "Wechsel" sind erlaubt.
Clicking: Es erfolgt nur durch Anklicken eine Reaktion.
Externally: Nur der programmseitigen Aufruf von "Wechsel" ist erlaubt.
No: Die Komponente führt zur Zeit keinen Wechsel aus.

OnModification (TNotifyEvent) [Nur zur Laufzeit]
Dieses Ereignis wird ausgelöst, wenn die Komponente ihren Zustand ändert 
(also bei Wechsel markiert <--> unmarkiert).

Selected (Boolean) [Nur zur Laufzeit, nur Lesen]
Gibt Auskunft, ob die Komponente zur Zeit gerade markiert ist (True)
oder nicht (False).

LastRequest (NotYet,ByClicking,FromProgram) [Nur zur Laufzeit, nur Lesen]
Gibt Auskunft, ob und durch wen die letzte Anforderung zum Wechsel erfolgt ist,
unabhängig davon, ob der Wechsel auch durchgeführt wurde.
NotYet: Es ist noch keine Anforderung erfolgt.
ByClicking: Die Komponente wurde als Letztes angeklickt.
FromProgram: Die letzte Anforderung erfolgte durch programmseitigen Aufruf
der Funktion "Wechsel".

Wechsel (Function:Boolean) [Nur zur Laufzeit]
Wechselt (bei entsprechender Erlaubnis) den Zustand der Komponente 
(markiert <--> unmarkiert) und meldet zurück, ob der Wechsel auch erfolgt
ist (True) oder ob die Anforderung abgewiesen wurde (False).