Prev Next Up Title Contents Index

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.


Prev Next Up Title Contents Index