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.