const
lzSubrichName='
Subrich';
lzMemoName='
Memo';
type
tShowOpt_UA =(ShowSubRichEd_UA, ShowstatBar_UA,ShowHeadContr_UA);
tShowOpts_UA =
set of tShowOpt_UA;
TSimpTestRich_UA =
class(TRichEdit)
private
FSubRichEd: trichedit;
FShowOpts:tShowOpts_UA;
FReadyForTmp:boolean;
function GetShowpts: tshowOpts_UA;
procedure SetShowpts(
const Value: tshowOpts_UA);
procedure setReadyForTmp(
const Value: boolean);
{ private declarations }
protected
{ protected declarations }
public
{ public declarations }
published
{ published declarations }
property ReadyForTmp: boolean
read FReadyForTmp
write setReadyForTmp;
property ShowOpts: tshowOpts_UA
read GetShowpts
write SetShowpts;
property SubRichEd: trichedit
read FSubRichEd
write FSubRichEd;
constructor Create(AOwner:TComponent);
override;
procedure CreateSubrichEd;
virtual;
procedure DeleteSubrichEd;
virtual;
procedure createTmpMemo;
function getTmpMemo:tmemo;
procedure deleteTmpMemo;
function getComponentName(anam:
string):
string;
procedure expresscontrols(doother:boolean);
virtual;
Procedure onselfMouseDown(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
virtual;
//ermöglicht hier das Bewegen und Veränderung der Größe bei Gedrückter Stringtaste
end;
{ TSimTestrich_UA }
constructor TSimpTestrich_UA.Create(AOwner: TComponent);
begin
inherited;
Width:=2*width;
//ShowOpts:=showopts-[ShowSubRichEd_UA]; geht hier nicht, da wohl die setRoutinen der Eiogenschaften noch nicht gerufen werden dürfen
// CreateSubrichEd; hier ist Name und z.B. ShowOpts nicht geladen
//lines.add('Mein Name in Create: '+ name); geht hier nicht, Meldung: Element '' hat kein übergeordnetes Fenster, heißt wohl, Parent ist noch nicht gesetzt
onmousedown:=onselfMouseDown;
//zum Testen
end;
procedure TSimpTestRich_UA.CreateSubrichEd;
begin
if not assigned(SubRichEd)
then
begin
SubRichEd:=trichedit.create(self);
SubRichEd.parent:=self.parent;
SubRichEd.
name:=getComponentName(lzSubrichName);
//ein eindeutiger Name
SubRichEd.top:=self.top-5;
SubRichEd.Height:=self.Height-10;
SubRichEd.left:=self.left+self.Width;
SubRichEd.width:=self.Width-10;
end;
end;
procedure TSimpTestRich_UA.createtmpmemo;
begin
if getTmpMemo =nil
then
with tmemo.create(self)
do
begin
parent:=self.parent;
top:=self.top+self.Height;
left:=self.left;
name := getComponentName(lzMemoName);
// eindeutiger Name
end;
end;
procedure TSimpTestRich_UA.DeleteSubrichEd;
begin
if assigned(SubRichEd)
then subriched.free;
subriched:=nil;
//sonst ergäbe ein erneutes Assignde TRUE, obowohl das object gelöscht ist
//freeandnil(SubRichEd); geht nicht da E2197 Konstantenobject kann nicht als Var-Parameter weitergegeben werden
end;
procedure TSimpTestRich_UA.deleteTmpMemo;
begin
getTmpMemo.free;
//freeandnil(getTmpMemo) geht nicht
end;
procedure TSimpTestrich_UA.expresscontrols(doother: boolean);
var i:integer;
begin
// das wäre die Notlösung, wenn man alle componenten in TSimpTestrich_UA.Create eerzeugen würde, aber parent dot noch nicht bekannt ist
for I := 0
to componentcount-1
do
if components[i]
is tcontrol
then
begin
with tcontrol(components[i])
do
begin
parent:=self.parent;
end;
if components[i]
is trichedit
then
begin
trichedit(components[i]).Lines.Add('
Mein Name in Expresscontrols: '+components[i].
Name);
end;
end;
end;
function TSimpTestRich_UA.getComponentName(anam:
string):
string;
begin
result:=name
// der eigene Name
+'
_'+
anam
// der Componetenname
+'
_'+
'
UA'
//eine persönliche Erweiterung
end;
function TSimpTestRich_UA.GetShowpts: tshowOpts_UA;
begin
result:= FShowOpts
end;
function TSimpTestRich_UA.getTmpMemo: tmemo;
begin
result:=findcomponent(getComponentName(lzMemoName))
as tmemo;
end;
procedure TSimpTestRich_UA.onselfMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if button =mbRight
then
begin
//showopts ändeern - in setShoOpts werden dann die Componenten erzeugt oder gelöscht
if ShowSubRichEd_UA
in ShowOpts
then showOpts:= ShowOpts-[showsubriched_UA]
else showOpts:= ShowOpts+[showsubriched_UA];
end;
if button =mbLeft
then
begin
setReadyForTmp(
not ReadyForTmp);
end;
end;
procedure TSimpTestRich_UA.setReadyForTmp(
const Value: boolean);
begin
//alle anderen Komponenten erzeugen oder löschen
FReadyForTmp:=value;
if value
then
begin
createTmpMemo;
//und alle anderen ohne Feld
end else
begin
deleteTmpMemo
//und alle anderen ohne Feld
end;
end;
procedure TSimpTestRich_UA.SetShowpts(
const Value: tshowOpts_UA);
begin
FShowOpts:=Value;
if ShowSubRichEd_UA
in ShowOpts
then createsubriched
else deletesubriched;
{
if ShowSubRichEd_UA in ShowOpts then SubRichEd.Show
else SubRichEd.hide;
}
// geht beim setzten von ShowSubriched in der IDE nicht - hat noch kein Fenster
// if ShowSubRichEd_UA in ShowOpts then subriched.lines.add('bin sichtbar')
// else subriched.lines.add('bin UNsichtbtar');
end;