Prev Next Up Title Contents Index

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.


Prev Next Up Title Contents Index