unit chclr; {------------------------------------------------------------------------------- Modulissa on esimerkki omasta komponentista. Komponentin tarkoitus on tarjota helppo väline lomakkeen kontrollien ajonaikaiseen värien vaihtamiseen ja tilanteen tallettamiseksi ini-tiedostoon. Tekijä: Vesa Lappalainen Aika: 23.8.1996 Delphi-versio: 1.0 & 2.0 Komponentit: TColorChange Muutokset: 23.8.1996 + Delphi 1.0:aa varten muutettu root-tallettumaan nimelle root, jollei sillä ole omaa nimeä Käyttö: Sijoitetaan lomakkeelle TColorChange-komponentti. Ominaisuudet: (TColorDialog+) IniName - käytettävän ini-tiedoston nimi Section - otsikko, jonka alle tiedot talletetaan AutoSave - talletetaanko automaattisesti komponenti hävitessä Metodit: (tärkeimmät) Ask(comp:TObject) - kysyy ja vaihtaa uuden värin komponentille ReadColors - lukee ini-tiedostosta värit Käsittelee vain niitä kontrolleja, jotka on sijoitettu sille lomakkeelle, jolle TColorChange-komponenttikin on sijoitettu. Komponentin väri vaihdetaan kutsulla ColorChange.Ask(comp) samalla komponentin väri merkitään talletettavaksi ini-tiedostoon. Mikäli AutoSave-ominaisuus on päällä, niin ohjelman lopuksi talletaan ini-tiedostoon ominaisuudesta valitun otsikon (section) alle kaikkien muutettujen komponenttien värit. Esim. (colors=oletus section) [colors] Edit1=$FF00 Form1=$808080 Panel1=$80FF Seuraavaa käynnistyskertaa varten kannattaa esim FormCreate -metodiin laittaa ColorChange.ReadColors; (Tätä ei voida tehdä automaattisesti, koska välttämättä kaikki komponentit eivät ole vielä lomakkeella, kun ColorChange-komponentti luodaan!) Värin vaihto voidaan tehdä esim. oikean napin Popup menulla: Tehdään PopupMenu, jossa yksi kohta on Vari ja kirjoitetaan sen tapahtumaksi: ColorChange.Ask(PopupMenuVari.PopupComponent); Tämä PopupMenu asetetaan PopupMenuksi kaikille niille komponenteille, joiden väriä halutaan muuttaa ajon aikana. Kannattaa muistaa mikä vaikutus on komponenttien ParentColor-ominaisuudella. Vähemmän tärkeät metodit ja niiden käyttö kommentoitu koodissa. -------------------------------------------------------------------------------} interface uses SysUtils, Classes, Graphics, Controls, Dialogs, IniFiles; const chNoColor = -2; { Vakio laittomalle värille } type {------------------------------------------------------------------------------} cColorCompItem = class { Ensin apuluokka väritietojen tallettamiseksi } protected name : string[30]; { Talletetaan vain objektin tiedot, koska obj. voi } color : TColor; { kadota ennenkuin sen tiedot on talletettu } public constructor Create(n:string;c:TColor); function GetName:string; function GetColor:TColor; function SetColor(c:TColor):boolean; end; { cColorCompItem } {------------------------------------------------------------------------------} cColorCompList = class(TList) { Luokka värillisten olioiden tallettamiseksi } protected public destructor Destroy; override; function Find(name:string):cColorCompItem; function Update(name:string;color:TColor):boolean; end; { cColorCompList } {------------------------------------------------------------------------------} TColorChange = class(TColorDialog) { Varsinainen värin muuttamisluokka } private { Private declarations } FIniSection:string; { [section] - johon ini-tied. talletaan } FIniName:string; { Ini-tiedoston nimi, johon talletetaan } root:TComponent; { Kuka omistaa kaikki komponentit } CompsList:cColorCompList; { Muuttettujen komp. väritiedot } saved:boolean; { Onko talletettu } FAutosave:boolean; { Talletaanko automaattisesti } protected { Protected declarations } public { Public declarations } constructor Create(AOwner:TComponent); override; destructor Destroy; override; function IsMyComponent(obj:TObject):boolean; virtual; function CompName(obj:TObject):string; virtual; function FindComponent(s:string):TComponent; virtual; function GetColor(comp:TObject):TColor; virtual; function SetColorAndOptionallySave(comp:TObject; color:TColor; save:boolean):boolean; virtual; function SetColorAndSave(comp:TObject; color:TColor):boolean; virtual; function Ask(comp:TObject):boolean; virtual; function ReadColor(Ini:TIniFile;section:string;entry:string):TColor;virtual; procedure WriteColor(Ini:TIniFile;section:string;entry:string;color:TColor); virtual; procedure ReadCompColor(Ini:TIniFile;section:string;entry:string; comp:TObject); virtual; procedure WriteCompColor(Ini:TIniFile;section:string;entry:string; comp:TObject); virtual; function ReadColors:boolean; virtual; function SaveColors:boolean; virtual; published { Published declarations } property IniName : string read FIniName write FIniName; property IniSection : string read FIniSection write FIniSection; property AutoSave : boolean read FAutosave write FAutosave default true; end; { TColorChange } procedure Register; implementation type {------------------------------------------------------------------------------} { Aluksi luokka, joka on itse asiassa sama kuin TControl, mutta jolla saadaan } { väri julkiseksi ominaisuudeksi. } TColorControl = class(TControl) published property Color; end; {------------------------------------------------------------------------------} { cColorCompItem xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx} {------------------------------------------------------------------------------} {------------------------------------------------------------------------------} constructor cColorCompItem.Create(n:string;c:TColor); begin inherited Create; name := n; color := c; end; {------------------------------------------------------------------------------} function cColorCompItem.GetName:string; begin Result := name; end; {------------------------------------------------------------------------------} function cColorCompItem.GetColor:TColor; begin Result := color; end; {------------------------------------------------------------------------------} function cColorCompItem.SetColor(c:TColor):boolean; { Vaihdetaan väri ja ilmoitetaan mikäli väri muuttui } begin Result := ( color <> c ); color := c; end; {------------------------------------------------------------------------------} { cColorCompList xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx} {------------------------------------------------------------------------------} {------------------------------------------------------------------------------} destructor cColorCompList.Destroy; var i:integer; begin for i:=Count-1 downto 0 do begin TObject(Items[i]).Free; Delete(i); end; inherited destroy; end; {------------------------------------------------------------------------------} function cColorCompList.Find(name:string):cColorCompItem; var i:integer; item : cColorCompItem; begin name := AnsiUpperCase(name); for i:=0 to Count-1 do begin item := Items[i]; if ( AnsiUpperCase(item.GetName) = name ) then begin Result := item; exit; end; end; Result := NIL; end; {------------------------------------------------------------------------------} function cColorCompList.Update(name:string;color:TColor):boolean; { Joko lisää uuden alkion tai päivitää vanhaa jos löytyy } var item:cColorCompItem; begin Result := false; if ( name = '' ) then exit; item := Find(name); if ( item <> NIL ) then begin Result := item.SetColor(color); exit; end; item := cColorCompItem.Create(name,color); if ( item = NIL ) then exit; Add(item); Result := true; end; {------------------------------------------------------------------------------} { TColorChange xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx} {------------------------------------------------------------------------------} {------------------------------------------------------------------------------} function TColorChange.CompName(obj:TObject):string; { Palautetaan objektin nimi. Jos '' ja root, niin root } begin Result := ''; if ( not ( obj is TComponent ) ) then exit; Result := (obj as TComponent).Name; if ( Result <> '' ) then exit; if (obj <> root) then exit; Result := 'root'; end; {------------------------------------------------------------------------------} function TColorChange.IsMyComponent(obj:TObject):boolean; { Tutkii onko komponentti joko root tai rootin komponentti } begin Result := false; if ( not ( obj is TComponent ) ) then exit; Result := (obj = root) or ( (obj as TComponent).Owner = root ) end; {------------------------------------------------------------------------------} function TColorChange.FindComponent(s:string):TComponent; { Etsii rootista komponentin, jonka nimi on s. Myös root käy! } begin Result := root.FindComponent(s); if ( Result <> NIL ) then exit; Result := root; if ( AnsiUppercase(s) = AnsiUppercase(root.Name) ) then exit; if ( AnsiUppercase(s) = AnsiUppercase('root') ) then exit; Result := NIL; end; {------------------------------------------------------------------------------} function TColorChange.GetColor(comp:TObject):TColor; begin Result := chNoColor; if ( comp is TControl ) then Result := TColorControl(comp).Color; end; {------------------------------------------------------------------------------} function TColorChange.SetColorAndOptionallySave( comp:TObject; { o Komponentti, jonka väri muuttuu } color:TColor; { i Komponentin uusi väri } save:boolean { i Talletaanko muutos sisäiseen listaan } ):boolean; { Laittaa komponentille uuden värin ja tallettaa muutoksen sisäiseen listaan jos komponentti on rootin omistama. Päivittää myös tiedon muuttuessa luokan saved-lippua. Palautetaan onnistuiko värin vaihtaminen. -------------------------------------------------------------------------------} var newitem: TObject; oldcolor : TColor; begin result := false; if not ( comp is TControl ) then exit; oldcolor := GetColor(comp); if ( oldcolor = chNoColor ) then exit; Result := True; if ( oldcolor = color ) then exit; TColorControl(comp).Color := color; if ( TColorControl(comp).Color <> color ) then exit; { Väri ei vaihtunut? } if ( IsMyComponent(comp) and save and CompsList.Update(CompName(comp),color) ) then saved := false; end; {------------------------------------------------------------------------------} function TColorChange.SetColorAndSave(comp:TObject; color:TColor):boolean; begin Result := SetColorAndOptionallySave(comp,color,true); end; {------------------------------------------------------------------------------} function TColorChange.Ask(comp:TObject):boolean; { Vaihtaa komponentin värin väridialogilla käyttäjältä kysyen. Palauttaa vaihdettiinko väri. -------------------------------------------------------------------------------} var newcolor:TColor; begin Result := false; newcolor := GetColor(comp); if ( newcolor = chNoColor ) then exit; self.Color := newcolor; if ( not self.Execute ) then exit; Result := SetColorAndSave(comp,self.Color); end; {------------------------------------------------------------------------------} function TColorChange.ReadColor( Ini:TIniFile; { i Valmiiksi avattu ini-tiedosto } section:string; { i [section] } entry:string { i entry= } ):TColor; { f ko. kohdan alta löytynyt väri } { Luetaan ini-tiedostosta väritieto } begin Result := Ini.ReadInteger(section,entry,chNoColor); end; {------------------------------------------------------------------------------} procedure TColorChange.WriteColor( Ini:TIniFile; { i Valmiiksi avattu ini-tiedosto } section:string; { i [section] } entry:string; { i entry= } color:TColor); { i väri } { Kirjoitetaan väri ini-tiedostoon entry=$800000 } begin if ( color = chNoColor ) then exit; Ini.WriteString(section,entry,format('$%x',[color])); end; {------------------------------------------------------------------------------} procedure TColorChange.ReadCompColor( Ini:TIniFile; { i Valmiiksi avattu ini-tiedosto } section:string; { i Otsikko, jonka alta luetaan } entry:string; { i komponentin nimi, joka luetaan } comp:TObject); { o komponentti, johon tulos sijoitetaan } { Luetaan komponentin väri ini-tiedostosta } var color:TColor; begin if ( comp = NIL ) then exit; color := ReadColor(Ini,section,entry); if ( color <> chNoColor ) then SetColorAndOptionallySave(comp,color,false); end; {------------------------------------------------------------------------------} procedure TColorChange.WriteCompColor( Ini:TIniFile; { i Valmiiksi avattu ini-tiedosto } section:string; { i Otsikko, jonka alle kirjoitetaan } entry:string; { i nimi, johon väri kirjoitetaan } comp:TObject); { i komponentti, jonka väri kirjoitetaan } { Kirjoitetaan komponentin nimi=väri ini-tiedostoon (nimi=entry) } begin WriteColor(Ini,section,entry,GetColor(comp)); end; {------------------------------------------------------------------------------} function TColorChange.ReadColors:boolean; { Luetaan kaikki [section]-kohdan alta löytyvät otsikot ja etsitään näitä nimiä vastaavat komponentit ja yritetään laittaa väri kullekin komponentille. Jos IniName on tyhjä, lueta. Palautetaan onnistuiko lukeminen -------------------------------------------------------------------------------} var i:integer; s:string; sec:TStringList; comp : TComponent; Ini:TIniFile; begin Result := false; if ( IniName = '' ) then exit; Ini := TIniFile.Create(IniName); if ( Ini = NIL ) then exit; sec := TStringList.Create; Ini.ReadSection(IniSection,sec); for i:=0 to sec.Count-1 do begin s := sec.Strings[i]; ReadCompColor(Ini,IniSection,s,FindComponent(s)); end; Result := true; saved := true; sec.free; Ini.free; end; {------------------------------------------------------------------------------} function TColorChange.SaveColors:boolean; { Kirjoitetaan kaikki sisäisessä listassa olevat muuttuneet värit ini-tiedostoon. Palautetaan onnistuiko tallettaminen. -------------------------------------------------------------------------------} var color:TColor; i:integer; s:string; Ini:TIniFile; item : cColorCompItem; begin Result := false; if ( IniName = '' ) then exit; Ini := TIniFile.Create(IniName); if ( Ini = NIL ) then exit; for i:=0 to CompsList.Count-1 do begin item := CompsList.Items[i]; WriteColor(Ini,IniSection,item.name,item.color); end; Result := true; saved := true; Ini.free; end; {------------------------------------------------------------------------------} constructor TColorChange.Create(AOwner:TComponent); begin inherited Create(AOwner); FIniName := ''; FIniSection := 'colors'; root := AOwner; CompsList := cColorCompList.Create; saved := true; FAutoSave := true; end; {------------------------------------------------------------------------------} destructor TColorChange.Destroy; begin if ( AutoSave and not saved ) then SaveColors; CompsList.Free; inherited Destroy; end; {------------------------------------------------------------------------------} procedure Register; begin RegisterComponents('Samples', [TColorChange]); end; end.