unit LabEdit;
interface
uses Windows, Controls, Graphics, Classes, StdCtrls, Dialogs, Messages, Math, SysUtils;
const MouseClick = WM_LBUTTONDOWN;
MouseOver = CM_MOUSEENTER;
MouseLeave = CM_MOUSELEAVE;
type TOnChangeEvent =
procedure of Object;
type TLabEdit =
Class(TWinControl)
private
// Eigenschaftsvariablen
FbEnabled, FbVisible, FbMouseOverComponent: boolean;
FiTextLength, FiMaxTextLength: integer;
// Komponenten
FsTextWert:
string;
FLblAnzeige: TLabel;
FEdEingabe: TEdit;
// Eventvariablen
FOnClick: TNotifyEvent;
FOnChange: TOnChangeEvent;
// create-Funktionen für das Label und das Edit
function CreateLabel(PosX, PosY, Textgroesse: integer; Caption:
string; visible: boolean): TLabel;
function CreateEdit(PosX, PosY, Width, Height, Textgroesse: integer; Caption:
string; visible: boolean): TEdit;
// Interaktions-Prozeduren
procedure FLblOnClick(Sender: TObject);
procedure FEdKeyDown(Sender: TObject;
var Key: Word; Shift: TShiftState);
// Änderungs-Prozeduren
procedure ChangeEmbeddedEdit;
// Setter- und Getter
procedure SetEnabled(bWert: boolean);
function GetEnabled: boolean;
procedure SetText(sWert:
string);
function GetText:
string;
procedure SetVisible(bWert: boolean);
function GetVisible: boolean;
function GetTextLength: integer;
procedure SetMaxTextLength(iWert: integer);
// Event-Prozeduren
procedure WMMouseClick(
var Msn: TMessage);
message MouseClick;
procedure CMMouseOver(
var Msn: TMessage);
message MouseOver;
procedure CMMouseLeave(
var Msn: TMessage);
message MouseLeave;
protected
procedure createWnd;
override;
published
property OnChange: TOnChangeEvent
read FOnChange
write FOnChange;
property Enabled: boolean
read GetEnabled
write SetEnabled;
property Visible: boolean
read GetVisible
write SetVisible;
property Text:
string read GetText
write SetText;
property Font;
property MaxLength: integer
write SetMaxTextLength;
public
constructor create(AOwner: TComponent);
override;
destructor destroy;
override;
property Length: integer
read GetTextLength;
End;
implementation
constructor TLabEdit.create(AOwner: TComponent);
begin
inherited create(AOwner);
Controlstyle := Controlstyle - [csAcceptsControls];
// Der Componente wird nicht erlaubt
// andere Componenten aufzunehmen,
// als die, die durch den Programmierer
// hier einprogrammiert werden.
Visible := true;
Enabled := true;
// Eventzeiger zurücksetzen
FOnClick :=
nil;
FOnChange :=
nil;
// Defaultwerte setzen
FbEnabled := true;
FbVisible := true;
FsTextWert := '
Hallo';
end;
destructor TLabEdit.Destroy;
begin
FLblAnzeige.Free;
FEdEingabe.Free;
inherited destroy;
end;
{////////////////////////////////////////////////////////////////////////////////////}
{/ Create-Funktionen /}
{////////////////////////////////////////////////////////////////////////////////////}
function TLabEdit.CreateLabel(PosX: Integer; PosY: Integer; Textgroesse: Integer; Caption:
string; visible: Boolean): TLabel;
begin
result := TLabel.Create(
nil);
result.Parent := Self;
result.Left := PosX;
result.Top := PosY;
result.Font.Assign(Font);
result.Caption := Caption;
result.Visible := visible;
end;
function TLabEdit.CreateEdit(PosX, PosY, Width, Height, Textgroesse: integer; Caption:
string; visible: boolean): TEdit;
begin
result := TEdit.Create(
nil);
result.Parent := Self;
result.Left := PosX;
result.Top := PosY;
result.Width := Width;
result.Text := Caption;
result.Font.Assign(Font);
result.Visible := visible;
end;
{////////////////////////////////////////////////////////////////////////////////////}
{/ Setter und Getter /}
{////////////////////////////////////////////////////////////////////////////////////}
function TLabEdit.GetText:
string;
begin
result := FLblAnzeige.Caption;
end;
procedure TLabEdit.SetText(sWert:
string);
begin
FsTextWert := sWert;
FLblAnzeige.Caption := sWert;
FEdEingabe.Text := FLblAnzeige.Caption;
end;
procedure TLabEdit.SetEnabled(bWert: Boolean);
begin
FbEnabled := bWert;
//Enabled := bWert; <---- Hier gibt es den großen Fehler
end;
function TLabEdit.GetEnabled;
begin
result := FbEnabled;
end;
procedure TLabEdit.SetVisible(bWert: boolean);
begin
FbVisible := bWert;
//Visible := bWert; <---- Hier gibt es den großen Fehler
end;
function TLabEdit.GetVisible:boolean;
begin
result := FbVisible;
end;
function TLabEdit.GetTextLength: integer;
begin
FiTextLength := strLen(PAnsiChar(FsTextWert));
result := strLen(PAnsiChar(FsTextWert));
end;
procedure TLabEdit.SetMaxTextLength(iWert: integer);
begin
FiMaxTextLength := iWert;
FEdEingabe.MaxLength := FiMaxTextLength;
end;
{////////////////////////////////////////////////////////////////////////////////////}
{/ Änderungs-Prozeduren /}
{////////////////////////////////////////////////////////////////////////////////////}
procedure TLabEdit.ChangeEmbeddedEdit;
begin
Height := FEdEingabe.Height;
FEdEingabe.Width := FLblAnzeige.Width + 20;
Width := FEdEingabe.Width;
end;
{////////////////////////////////////////////////////////////////////////////////////}
{/ Funktionen für die Interaktion /}
{////////////////////////////////////////////////////////////////////////////////////}
procedure TLabEdit.FLblOnClick(Sender: TObject);
begin
FLblAnzeige.Visible := false;
FEdEingabe.Visible := true;
end;
procedure TLabEdit.FEdKeyDown(Sender: TObject;
var Key: Word; Shift: TShiftState);
begin
// Die Änderung hier an dieser Prozedur sehen wie folgt aus: OnChange wird nur
// aktiviert, wenn eine Eingabe getätigt wurde, die verschieden von der vorherigen
// ist.
// Bei Esc wird alles wieder zurückgesetzt und das OnChangeEvent wird nicht aktiviert.
if key
in [13, 27]
then
begin
FEdEingabe.Visible := false;
FLblAnzeige.Visible := true;
case key
of
13:
begin
FLblAnzeige.Caption := FEdEingabe.Text;
if FsTextWert <> FEdEingabe.Text
then if assigned(FOnChange)
then FOnchange;
FsTextWert := FEdEingabe.Text;
end;
27: FEdEingabe.Text := FsTextWert;
end;
end
else
begin
inherited;
FLblAnzeige.Caption := FEdEingabe.Text;
ChangeEmbeddedEdit;
end;
end;
{////////////////////////////////////////////////////////////////////////////////////}
{/ Events /}
{////////////////////////////////////////////////////////////////////////////////////}
procedure TLabEdit.WMMouseClick(
var Msn: TMessage);
begin
inherited;
if assigned(FOnClick)
then FOnClick(Self);
FEdEingabe.Visible := true;
FLblAnzeige.Visible := false;
end;
// Wenn die Maus über dem Label ist, ändert sich der Cursor, damit erkannt werden
// kann, dass man hier eine Eingabe tätigen kann.
procedure TLabEdit.CMMouseOver(
var Msn: TMessage);
begin
Cursor := crHandPoint;
end;
// Cursor wird auf den normalen Default-Cursor zurück gesetzt.
procedure TLabEdit.CMMouseLeave(
var Msn: TMessage);
begin
Cursor := crDefault;
end;
{////////////////////////////////////////////////////////////////////////////////////}
{/ CreateWnd-Funktion /}
{////////////////////////////////////////////////////////////////////////////////////}
procedure TLabEdit.CreateWnd;
begin
inherited createwnd;
FLblAnzeige := CreateLabel(3, 3, 18, FsTextWert, true);
FLblAnzeige.OnClick := FLblOnClick;
FEdEingabe := CreateEdit(0,0, FLblAnzeige.Width + 20, FLblAnzeige.Height, FLblAnzeige.Font.Height, FLblAnzeige.Caption, false);
FEdEingabe.OnKeyDown := FEdKeyDown;
ChangeEmbeddedEdit;
end;
end.