EditCap -komponetti
editcap.pas - komponentti, jossa Edit-kenttä ja otsikko liikkuvat yhdessä
unit editcap;
{------------------------------------------------------------------------------}
{
Tässä mallissa luodaan oma komponentti TEditCap,
jossa kulkee yhdessä sekä edit-kenttä, että siihen liittyvä ohjeteksti.
Komponentti tehdään perimällä TEdit ja liittämällä siihen yhdeksi
jäseneksi TLabelista peritty tekstin näyttävä luokka (TLabelCap).
TEditCap - edit-ikkunan tapaan toimiva ikkuna, jonka mukana on
aina siihen liittyvä "otsikko", caption
TLabelCap - kuten TLabel, mutta kun tuhotaan tuhoaa myös
oman FocusControl-ikkunansa (joka useimmiten on TEditCap)
Kun nimeä muutetaan, muuttaa vastavasti omaa otsikkoaan
=> voidaan nimetä LabelCapNimi => caption := Nimi
Vesa Lappalainen 25.8.1996
Homma tuntui aluksi aivan triviaalilta ja tästä piti tulla erittäin
yksinkertainen esimerkki - mutta! Ensimmäinen yllätys oli, että
kun komponentti loi toisen, niin suunnitteluvaiheessa tämä luotukin
komponentti tallettui resursseihin. Toisaalta tämä olikin ihan hyvä,
näin voi sitten muutella TLabelCap-olion ominaisuuksia melko irrallaan
"isännästään". Sitten alkoikin...
Vaikeaa oli:
- saada molemmat erilliset komponentit elämän yhteistä "elämää"
1. kun luodaan TEditCap, pitäisi tietysti luoda myös sitä
vastaava TLabelCap. Mutta jos onkin kyseessä ohjelman
käynnistäminen, niin resurssitiedostossa on molemmat
valmiina, eli jos jokaista TEditCapia kohti luotaisiin oma
TLabelCap, olisi TLabelCapeja liikaa (ja olikin #[currency]%&@)
2. Edelliseen ratkaisu on tutkia luotavan TEditCap-olion
luomisen aikana. Jos on päällä tila csLoading, eli komponenttia
ollaan lataamassa joko resurssitiedostosta tai leikekirjasta,
niin ei luodakaan TLabelCap-oliota, koska kohta sekin luetaan
resurssitiedostosta
3. Valitettavasti ko. tila ei ole päällä vielä Create-konstruktorissa!
(kuten ei ole komponentilla nimeäkään eikä paljon mitään muitakaan
ominaisuuksia). No tässä tapauksessa päätettiin, että jokaisella
komponentilla on OLTAVA oma nimi. Tällöin nimen sijoitusvaiheessa
komponentilla jo on ko. ominaisuus jos on ollakseen (ainakin testien
mukaan). Siis uusi TLabelCap-olio luodaan SetName-proseduurissa.
4. TLabelCap-oliolle pitäsi saad sama isä kuin TEditCap-komponentilla.
Mutta kun mahdollisssa luontivaiheessa ei välttämättä isää ole
vielä edes TEditCap-komponentilla. Erityisesti näin näytti olevan
silloin, kun komponentti pudotetaan suunnitteluvaiheessa lomakkeelle.
=> kun TEditCapin isä muuttuu, muutetana vastaavan TLabelCap
olion isä (jos ko. olio on olemassa).
5. Miten oliot saadaan sitten linkitettyä toisiinsa, jos toinen ei
saa luoda toista. Laitettiin TLabelCapin linkki ominaisuuteen
FocusControl (jossa se saakin olla :-). Tällöin ominaisuus
tallettuu leikekirjaan tai resurssitiedostoon ja kun olio
resurssitiedostosta luodaan ohjelman alkaessa tai kun lomake
ladataan uudelleen suunniteltavaksi, niin ominaisuus on paikallaan
ja linkki on kunnossa.
6. Entä varsinainen linkki TEditCap -> TLabelCap. Aluksi yritin
pitää sitä täysin privaattina ominaisuutena, mutta jos TLabelCap
tulikin resurssitiedostosta vasta TEditCapin jälkeen, en keksinyt
mitään tapaa laittaa tätä linkkiä kuntoon. Siispä täytyi lisätä
ominaisuus CaptionControl, jolloin ko. linkki tallettuu resursseihin
ja latausvaiheessa tulee siis automaattisesti kuntoon.
7. Mikäli jompikumpi tuhotaan, joutaisi toinen mennä samalla.
Tässäpä olikin vaara rekursioon jos kummankin tuhoa kutsui
toisen tuhoa destruktoria. Täytyi pitää komponentin tilalipulla
huolta siitä, että jo tuhoutumassa olevaa komponenttia ei enää
tuhota.
Jäi vielä vikoja:
- TLabelCap -ikkunan ei saa WN_MOVE -viestiä?
=> jos siirtää Labelia, niin TEditCap-ikkuna ei seuraa mukana
Samaan liittyy vähän se, että jos molemmat on valittuna ja
siirretään, niin TLabelCap hyppi aika omituisesti
- Jos halutaan olio leikekirjaan, pitää valita sekä TLabelCap
että TEditCap
}
{------------------------------------------------------------------------------}
interface
uses
Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,StdCtrls
;
type
TEditCap = class;
{------------------------------------------------------------------------------}
{ Aluksi avuksi otsikkokomponentti, joka osaa lähinnä tuhota isäntänsä ja }
{ toisaalta muuttaa otsikkonsa "loogisesti" nimestään }
{ Tätä voi käyttää omanakin komponenttinaan, jos tarvitsee. }
{------------------------------------------------------------------------------}
TLabelCap = class(TLabel)
private
procedure SetName(const NewName:TComponentName); override;
public
constructor CreateLink(AOwner:TComponent;link:TWinControl);
destructor Destroy; override;
end;
{------------------------------------------------------------------------------}
{ Numeroitu tyyppi otsikon eri sijoituspaikoille: }
{------------------------------------------------------------------------------}
TECaptionPosition = (ecLeft,ecTop,ecBottom,ecRight);
{------------------------------------------------------------------------------}
{ Varsinainen uusi komponentti. }
{------------------------------------------------------------------------------}
TEditCap = class(TEdit)
private
{ Private declarations }
FCap : TLabelCap; { Linkki otsikoonsa }
FCaptionWidth : integer; { Kuinka kaukana vas. otsikko on meistä}
FCaptionPos : TECaptionPosition; { Millä suunnalla otsikko on meistä }
protected
{ Protected declarations }
procedure SizeMove; virtual;{ Siirtää otsi. oikealle paikalleen }
function CreateCap:TLabelCap; virtual;{ Luo otsikko-olion }
function GetCaption:string; virtual;{ Ominaisuuksien apumetodit: }
procedure SetCaption(s:string);virtual;
procedure SetCaptionWidth(w:integer); virtual;
procedure SetCaptionPos(p:TECaptionPosition); virtual;
procedure SetName(const NewName:TComponentName); override;
procedure SetParent(AParent :TWinControl); override;
public
{ Public declarations }
constructor Create(AOwner:TComponent); override;
destructor Destroy; override;
procedure WMSize(var Message:TWMSize); message WM_SIZE;
procedure WMMove(var Message:TWMMove); message WM_MOVE;
published
{ Published declarations }
property Caption:string read GetCaption write SetCaption stored false;
property CaptionWidth:integer read FCaptionWidth write SetCaptionWidth
default 50;
property CaptionPos:TECaptionPosition read FCaptionPos write SetCaptionPos
default ecLeft;
property CaptionControl:TLabelCap read FCap write FCap
{$IFDEF VER90}
{Delphi 1.0:ssa ei voi osoittimille laittaa oletusta} default NIL
{$ENDIF}
;
end;
procedure Register;
{------------------------------------------------------------------------------}
implementation
{------------------------------------------------------------------------------}
{ Aluksi muutamia nimeämiseen liittyviä vakioita }
const GenericNameEdit = 'LabEditCap';
GenericNameLabel = 'LabelCap';
LabelPrefix = 'Lab';
{------------------------------------------------------------------------------}
{ TLabelCap xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx}
{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
procedure TLabelCap.SetName(const NewName:TComponentName);
{ Vaihdetaan nimi. Jos linkki johonkin EditCap-olioon, niin n:stä
ei välitetä, vaan nimi muodostetaan aina linkin avulla.
EditCap1 => LabelEditCap1
Samalla kun nimi vaihdetaan, vaihdetaan myös Caption seuraavin säännöin:
vanha uusi nimi caption syy
-------------------------------------------------------------------------------
1: LEC1 LECNimi 1 => Nimi caption on vanhan lopussa
2: ??? LabEditCapNimi => Nimi caption tyhjä ja gen.nimi alus
}
var i:integer;
n,gen,oldname,oldcap,s:string;
function SetCaption(start,n:string):boolean;
var s:string;
begin
if ( Pos(UpperCase(start),UpperCase(n)) = 1 ) then begin
Delete(n,1,Length(start));
Caption := n;
end;
end;
begin
gen := GenericNameLabel; n := NewName;
if ( FocusControl <> NIL ) then begin
n := LabelPrefix+FocusControl.Name;
gen := GenericNameEdit;
end;
oldname := Name; oldcap := Caption;
inherited SetName(n);
i := Pos(UpperCase(Caption),UpperCase(oldname));
if not ( ( i-1 + Length(Caption) = Length(oldname) ) and
( SetCaption(Copy(oldname,1,i-1),n) ) ) then
SetCaption(gen,Caption)
end;
{------------------------------------------------------------------------------}
constructor TLabelCap.CreateLink(AOwner:TComponent;link:TWinControl);
begin
inherited Create(AOwner); { Ensiksi luodaan itsemme }
FocusControl := link; { ja laitetaan sitten linkki isäntäämme }
end;
{------------------------------------------------------------------------------}
destructor TLabelCap.Destroy;
begin
Destroying; { Olion tilaan tuhoamislippu päälle }
if ( FocusControl <> NIL ) and
( not ( csDestroying in FocusControl.ComponentState ) ) then
FocusControl.Free; { Tuhotaan isäntä, jos se ei jo ole tuhoutumassa }
FocusControl := NIL;
inherited Destroy; { Ja sitten lopuksi tuhotaan itsemme }
end;
{------------------------------------------------------------------------------}
{ TEditCap xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx}
{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
procedure TEditCap.SizeMove;
{ Siirretään otsikko oikealle paikalleen. }
begin
if ( FCap = NIL ) then exit; {Jos ots ei olekaan, tämä tilanne on luonnin aik}
case ( CaptionPos ) of
ecLeft : begin
FCap.Left := self.Left - CaptionWidth;
FCap.Top := self.Top+(self.Height-FCap.Height) div 2;
end;
ecRight: begin
FCap.Left := self.Left + self.Width + 2;
FCap.Top := self.Top+(self.Height-FCap.Height) div 2;
end;
ecTop: begin
FCap.Left := self.Left;
FCap.Top := self.Top - FCap.Height;
end;
ecBottom: begin
FCap.Left := self.Left;
FCap.Top := self.Top + self.Height;
end;
end;
end;
{------------------------------------------------------------------------------}
function TEditCap.GetCaption:string;
{ Otsikko otetaankin omalta otsikko-olioltamme, jos sellainen on }
begin
Result := '';
if ( FCap = NIL ) then exit; { Tämä tilanne luontivaiheen alussa! }
Result := FCap.Caption;
end;
{------------------------------------------------------------------------------}
procedure TEditCap.SetCaption(s:string);
{ Otsikko asetetaan suoraan omalle otsikko-oliollemme, jos sellinen on }
begin
if ( FCap = NIL ) then exit; { Tämä tilanne luontivaiheen alussa! }
FCap.Caption := s;
end;
{------------------------------------------------------------------------------}
procedure TEditCap.SetCaptionWidth(w:integer);
{ Otsikon paikka meihin nähden silloin kun otsikko on vasemmalla. }
begin
FCaptionWidth := w;
SizeMove;
end;
{------------------------------------------------------------------------------}
procedure TEditCap.SetCaptionPos(p:TECaptionPosition);
begin
FCaptionPos := p;
SizeMove;
end;
{------------------------------------------------------------------------------}
procedure TEditCap.WMSize(var Message:TWMSize);
{ Käsitellän ikkunan koon muutosviesti siten, että ensin normaali ja sitten }
{ vielä siirretään otsikko oikealle paikalleen }
begin
inherited;
SizeMove;
end;
{------------------------------------------------------------------------------}
procedure TEditCap.WMMove(var Message:TWMMove);
{ Käsitellän ikkunan paikan muutosviesti siten, että ensin normaali ja sitten }
{ vielä siirretään otsikko oikealle paikalleen }
begin
inherited;
SizeMove;
end;
{------------------------------------------------------------------------------}
{ Poikkeusluokka sille, ettei otsikkoa saada luoduksi }
type ENoCaption = class(Exception) end;
{------------------------------------------------------------------------------}
function TEditCap.CreateCap:TLabelCap;
{ Tämä funktio hakee viitteen mahdolliseen Label-kentään.
Jos kenttä on jo luotu, on viite valmiina.
Muuten luodaan uusi caption osa.
}
var labname:string;
begin
Result := FCap; if ( FCap <> NIL ) then exit;
FCap := TLabelCap.CreateLink(self.Owner,self);
if ( FCap = NIL ) then raise ENoCaption.Create('No caption created!');
FCap.Parent := self.Parent; { self.Parent voi vielä olla NIL !#%&@ }
FCap.Name := LabelPrefix+self.Name;
SizeMove;
Result := FCap;
end;
{------------------------------------------------------------------------------}
procedure TEditCap.SetName(const NewName:TComponentName);
{ Kun nimeä muutetaan, on jo kokeilujen perusteella luonnin tyyppi selvillä, }
{ joten tässä päätetään samalla luodaanko otsikkokenttä jos sitä ei vielä ole. }
{ Ensin laitetaan nimi normaalisti ja estetää ettei teksti ole sama kuin nimi. }
{ Jos ollaan luomassa uutta siten, että sitä luetaan tietovirrasta }
{ (tällaisia tapauksia oli ainakin leikepöydältä tuleva komponentti }
{ suunnitteluvaiheessa ja ohjelman käynnistyessä resursseista tuleva }
{ komponentti. Samoin oli lomakkeen suunnittelun käynnistyessä }
{ uudestaan. Suunnittelulomake luodaan näköjään samoista resursseista), }
{ niin EI luoda TLabelCap-oliota, koska se todennäköisesti on jo }
{ luotu, tai sitten se tullaan luomaan heti kohta samasta tietovirrasta }
{ lukemalla. Linkit on tässä tapauksessa talletettu julkisten ominaisuuksien }
{ ansiosta myös tietovirtaan, joten ne tulevat automaattisesti kohdalleen. }
begin
inherited SetName(NewName); { Aluksi normaali nimen vaihto}
if ( Text = NewName ) then Text := ''; { Teksti tyhjäksi jos = nimi }
if ( csLoading in ComponentState ) then exit; { Tässä suurin juju!!! }
if ( CreateCap = NIL ) then exit; { Yritetään luoda otsikko }
FCap.Name := LabelPrefix+NewName; { Otsikolle meistä periyt.nimi}
if ( FCap.Parent = NIL ) then FCap.Parent := Parent;
end;
{------------------------------------------------------------------------------}
procedure TEditCap.SetParent(AParent :TWinControl);
{ Tämä sen takia, että jos isää ei ole aikanaan saatu TLabelCap-oliolle, niin }
{ laitetaan se viimeistään nyt. Toivottavasti ko. olion on olemassa, sillä }
{ tämän jälkeen sitä ei enää voida laittaa (jollei sitten tule nimen vaihtoa, }
{ jossa luodaam ko. otsikko ja vielä yritetään laittaa isä paikalleen) }
begin
inherited SetParent(AParent);
if ( AParent <> NIL ) and ( FCap <> NIL ) then FCap.Parent := AParent;
end;
{------------------------------------------------------------------------------}
constructor TEditCap.Create(AOwner:TComponent);
begin
inherited Create(AOwner); { Luodaan uusi itsemme }
FCap := NIL; { Ja alustetaan ominaisuudet kuten defaultissa luvat. }
Text := '0'; { Tämä temppu, jotta teksti saadaan pysymään tyhjänä }
FCaptionWidth := 50;
Text := '';
end;
{------------------------------------------------------------------------------}
destructor TEditCap.Destroy;
begin
Destroying; { Olion tilaan tuhoamislippu päälle }
if ( ( FCap <> NIL ) and not ( csDestroying in FCap.ComponentState ) ) then
FCap.Free; { Otsikko tuhotaan, mikä se on eikä ole vielä tuhoutumassa }
FCap := NIL;
inherited Destroy; { Lopuksi tuhotaan itsemme, slurp... }
end;
{------------------------------------------------------------------------------}
procedure Register;
{ Jokainen komponentti pitää rekisteröidä komponenttikirjastoon ja jollekin }
{ komponenttisivulle. }
begin
RegisterComponents('Samples', [TEditCap,TLabelCap]);
end;
end.