Delphi - Logikai típusok tárolása egy mezőbe

forráskód letöltése
Mellékelt példában készítünk egy olyan komponenst a TCheckListBox-ból származtatva, melyet ellátunk DataSource és DataField property-kkel, melyeken keresztül egy tetszőleges adatforráshoz kapcsolhatódhatunk. Mivel a TCheckListBox tetszőleges számú eleme mellett megjelenik egy CheckBox, így minden egyes sor egy-egy logikai értéket képvisel. Ezeket a logikai értékeket úgy tekintjük, mint egy nagyobb szám kettes számrendszerbeli felbontását. Ezzel megoldjuk azt, hogy több logikai típusú értéket egyetlen mezőbe tárolunk el az adattáblánkba. A mellékelt példaprogram megnyitása előtt a DBBitListBox.pas-ban lévő komponenst telepítenie kell a Delphi alá.

A komponens használatához állítsuk be a DataSource és DataField property-ket. Csak olyan mezőt válasszunk a táblából, melynek típusa megengedi, hogy egy egész számot tároljunk benne. Ezek után az Items property-n keresztül vegyük fel a szükséges elemeket.

Mivel a TCheckListBox komponens nem rendelkezik adatbázis elérési lehetőséggel, így létre kell hoznunk egy TFieldDataLink típusú objektumot a komponensen belül. Ennek segítségével képesek leszünk a szintén általunk létrehozott DataSource és DataField property-ket helyesen kezelni.

Létrehozáshoz célszerűen a komponens konstruktorát választjuk. A Control property-ében kell megadni azt az objektumot, melyhez az adatbázis kapcsolatot létesítjük. Ez nyilván most maga a komponensünk lesz, így a Self kulcsszót használjuk. Ezek után még három eseményhez rendelünk eseménykezelőt. Ezek részletes bemutatására az alábbiakban még visszatérünk.
constructor TDBBitListBox.Create(AOwner: TComponent);
begin
  inherited;
  FFieldDataLink:=TFieldDataLink.Create;
  with FFieldDataLink do begin
    Control:=Self;
    OnDataChange:=DoDataChange;
    OnUpdateData:=DoUpdateData;
    OnActiveChange:=DoActiveChange;
  end;
end;
A létrehozott objektumot a komponens destruktorában szüntetjük meg.
destructor TDBBitListBox.Destroy;
begin
  FFieldDataLink.Free;
  FFieldDataLink:=nil;
  inherited;
end;
Ezek után hozzuk létre a DataSource és DataField property-ket. A DataSource TDataSource típusú lesz, míg a DataField egyszerű sztring.
property DataField: string read GetDataField
      write SetDataField;
property DataSource: TDataSource read GetDataSource
      write SetDataSource;
Mind a két property esetében metódusokat kell használnunk az értékadáshoz és annak kiolvasásához is, mivel a property-k értékei most a TFieldDataLink osztályban kerülnek tárolásra.
procedure TDBBitListBox.SetDataField(const Value: string);
begin
  FFieldDataLink.FieldName:=Value;
end;

procedure TDBBitListBox.SetDataSource(
     const Value: TDataSource);
begin
  if FFieldDataLink.DataSource<>Value then begin
    FFieldDataLink.DataSource:=Value;
    if Value<>nil then begin
      Value.FreeNotification(Self);
    end;
  end;
end;

function TDBBitListBox.GetDataField: string;
begin
  result:=FFieldDataLink.FieldName;
end;

function TDBBitListBox.GetDataSource: TDataSource;
begin
  result:=FFieldDataLink.DataSource;
end;
Amint az a SetDataSource eljárásban látható is, abban az esetben, ha valós értéket kapunk a DataSource property részére, akkor a FreeNotification hívásával kérjük a rendszertől, hogy értesítse objektumunkat arról az esetről, ha törlésre kerül egy-egy komponens. Gondoljuk csak végig: szerkesztési időben saját komponensünk DataSource property-ében kiválasztunk például egy TTable komponenst. Ekkor a TFieldDataLink osztály kapcsolatot létesít ezzel az objektummal. A program fejlesztése során viszont feleslegessé válik és töröljük ezt a TTable komponenst. Ettől kezdve a TFieldDataLink osztály egy nem létező objektumra fog hivatkozni és ha így használnánk tovább a komponenst, akkor számos, változatos formájú és tartalmú hibaüzenetre számíthatunk.

Megoldás erre a problémára az, hogy értesülnie kell komponensünknek, hogy fenti TTable törlésre került szerkesztési időben.

Ehhez fenti lépésen túl még a Notification metódus felülírására is szükségünk lesz. Ez akkor kerül meghívásra, amikor egy új komponens kerül a Form-ra, vagy egy meglévőt törlünk. Számunkra most az utóbbi eset lesz érdekes. Amikor a kapott paraméterek alapján úgy látjuk, hogy törlés a művelet és a törlendő komponens egyezik a DataSource property-ben tárolt komponenssel, akkor ennek a property-nek azonnal a nil értéket kell adnunk és így már nem történhet hivatkozás egy nem létező objektumra.
procedure TDBBitListBox.Notification(AComponent:
    TComponent; Operation: TOperation);
begin
  inherited;
  if (Operation=opRemove) and (FFieldDataLink<>nil) 
         and (AComponent=DataSource) then begin
    DataSource:=nil;
  end;
end;
Nézzük most a TFieldDataLink osztály eseményeit. Az OnActiveChange következik be akkor, amikor a kapcsolt adatbázis aktiválásra kerül. Itt célszerű ellenőriznünk, hogy a beállított mező típusa megfelel-e a feladatunknak. Mivel ez most csak szám típusú lehet, így itt ezt kell ellenőriznünk. Ha a típus nem megfelelő, akkor hibát generálunk.
procedure TDBBitListBox.DoActiveChange(Sender: TObject);
begin
 if (FFieldDataLink<>nil) and (FFieldDataLink.Active) and
           (DataField<>'') and (FFieldDataLink.DataSet<>nil) 
           and (FFieldDataLink.DataSet.Active) then begin
  if not (FFieldDataLink.DataSet.FieldByName(DataField).DataType
           in [ftInteger, ftSmallint, ftWord, ftFloat]) then begin
      raise Exception.Create('DataField mező csak szám 
           típusú lehet!');
  end;
 end;
end;
Az OnUpdateData esemény jön létre akkor, ha aktualizálnunk kell az adattábla megadott mezőjét. Ezt úgy tesszük meg, hogy végignézzük a komponens összes elemét az Items tömbben és azoknál az elemeknél, ahol a Checked property igaz értéket tárol, ott azt egy kettes számrendszerbeli 1-nek vesszük és ebből előállítunk egy tízes számrendszerbeli számot. Végül az így kapott számot tároljuk az adattábla megadott mezőjébe a TFieldDataLink osztályon keresztül.
procedure TDBBitListBox.DoUpdateData(Sender: TObject);
var
 i, l: integer;
begin
  l:=0;
  for i:=0 to Items.Count-1 do begin
    if Checked[i] then begin
       l:=l+(1 shl i);
    end;
  end;
  FFieldDataLink.Field.Value:=l;
end;
OnDataChange esemény jön létre, amikor valamilyen külső hatás eredményeképpen változik meg a kapcsolt adattábla mezőjének értéke. Mellékelt példában akár a DBGrid1-en keresztül is értéket adhatunk a tábla B mezőjének, mely a programban a TDBBitListBox-hoz van kapcsolva. Ekkor az a teendőnk, hogy kiolvassuk a megváltozott adatot és a számunkra megfelelő módon frissítsük komponensünk tartalmát. Ehhez most az UpdateCheck belső eljárást hívjuk meg.
procedure TDBBitListBox.DoDataChange(Sender: TObject);
begin
  if FFieldDataLink.Field<>nil then begin
    UpdateCheck;
  end;
end;
Az UpdateCheck eljárásban első lépésként ideiglenesen megszüntetjük az OnDataChange eseménykezelő aktivizálását. Ezek után egy ciklus segítségével végignézzük az összes elemet az Items-ben, hogy a hozzátartozó Checked property-t igazra kell-e állítani vagy sem. Ehhez vizsgáljuk a FFieldDataLink.Field.Value értékét, melyből az adattábla adott mezőjének értékét kapjuk meg. Itt azt kell ellenőriznünk, hogy a számban az adott helyi értéken lévő bit 1 vagy 0.
procedure TDBBitListBox.UpdateCheck;
var
  i, l : integer;
begin
  FFieldDataLink.OnDataChange:=nil;
  l:=1;
  for i:=0 to Items.Count-1 do begin
    Checked[i]:=(FFieldDataLink.Field.Value and l)=l;
    l:=l*2;
  end;
  FFieldDataLink.OnDataChange:=DoDataChange;
end;
Figyelnünk kell még arra is, amikor a felhasználó a komponens CheckBox-ain kattint. Ekkor kerül meghívásra a komponens ClickCheck eljárása, melyet felülírtunk. Itt átmenetileg az OnDataChange eseménykezelőjét megszüntetjük, majd a TFieldDataLink osztály Edit eljárásának hívásával szerkesztő üzemmódba helyezzük az adattáblát és a Modified hívásával aktivizáljuk az OnUpdateData eseményét, melyen keresztül elvégezzük az értékadást.
procedure TDBBitListBox.ClickCheck;
begin
  inherited;
  if FFieldDataLink<>nil then begin
    with FFieldDataLink do begin
      if not ReadOnly then begin
        OnDataChange:=nil;
        Edit;
        Modified;
        OnDataChange:=DoDataChange;
        try
          FFieldDataLink.UpdateRecord;
        except
        end;
      end;
    end;
  end;
end;
További teendőnk az, hogy figyeljük az Esc gomb lenyomását. Ekkor a többi DataControls palettán lévő komponenshez hasonlóan vissza kell vonnunk az aktuális változtatásokat. Ezt a TFieldDataLink osztály Reset metódusának hívásával érhetjük el.
procedure TDBBitListBox.KeyPress(var Key: Char);
begin
  if Key=#27 then begin
    FFieldDataLink.Reset;
  end else begin
    inherited;
  end;
end;
Végül már csak egy feladatunk maradt: figyelnünk kell, hogy a felhasználó mikor hagyja el a komponensünket. Ekkor nem árt, ha frissítjük az adattábla tartalmát, hogy abban a komponensünkben tárolt értékeknek megfelelő szám kerüljön. Ehhez a TFieldDataLink osztálynak az UpdateRecord eljárását kell meghívnunk.
procedure TDBBitListBox.CMExit(var Msg: TMessage);
begin
  try
    FFieldDataLink.UpdateRecord;
  except
  end;    
  inherited;
end;