TColorChange - komponentti
chclr.pas - komponentti värien ajonaikaiseen vaihtamiseen
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.