home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 October / Chip_2001-10_cd1.bin / zkuste / delphi / kolekce / d6 / FRCLX.ZIP / SOURCE / FR_DBLookupCtl.pas < prev    next >
Pascal/Delphi Source File  |  2001-07-06  |  5KB  |  174 lines
  1.  
  2. {******************************************}
  3. {                                          }
  4. {   FastReport CLX v2.4 - DB components    }
  5. {              Lookup control              }
  6. {                                          }
  7. { Copyright (c) 1998-2001 by Tzyganenko A. }
  8. {                                          }
  9. {******************************************}
  10.  
  11. unit FR_DBLookupCtl;
  12.  
  13. interface
  14.  
  15. {$I FR.inc}
  16.  
  17. uses
  18.   Types, SysUtils, Classes, QGraphics, FR_Class, QStdCtrls,
  19.   QControls, QForms, QMenus, QDialogs, DB, QDBCtrls, FR_DCtrl;
  20.  
  21. type
  22.   TfrDBLookupControl = class(TfrStdControl)
  23.   private
  24.     FLookup: TDBLookupComboBox;
  25.     FListSource: String;
  26.   protected
  27.     procedure SetPropValue(Index: String; Value: Variant); override;
  28.     function GetPropValue(Index: String): Variant; override;
  29.   public
  30.     constructor Create; override;
  31.     destructor Destroy; override;
  32.     procedure LoadFromStream(Stream: TStream); override;
  33.     procedure SaveToStream(Stream: TStream); override;
  34.     procedure DefineProperties; override;
  35.     procedure Loaded; override;
  36.   end;
  37.  
  38.  
  39. implementation
  40.  
  41. uses FR_Utils, FR_DBRel, FR_DBUtils, FR_Const, Variants;
  42.  
  43.  
  44. { TfrDBLookupControl }
  45.  
  46. constructor TfrDBLookupControl.Create;
  47. begin
  48.   inherited Create;
  49.   FLookup := TDBLookupComboBox.Create(nil);
  50.   FLookup.Parent := frDialogForm;
  51.   AssignControl(FLookup);
  52.   BaseName := 'DBLookupComboBox';
  53.   dx := 145; dy := 21;
  54. end;
  55.  
  56. destructor TfrDBLookupControl.Destroy;
  57. begin
  58.   FLookup.Free;
  59.   inherited Destroy;
  60. end;
  61.  
  62. procedure TfrDBLookupControl.DefineProperties;
  63.  
  64.   function GetFields: String;
  65.   var
  66.     i: Integer;
  67.     sl: TStringList;
  68.     ds: TDataSet;
  69.   begin
  70.     Result := '';
  71.     if (FLookup.ListSource = nil) or (FLookup.ListSource.DataSet = nil) then Exit;
  72.     ds := FLookup.ListSource.DataSet;
  73.     sl := TStringList.Create;
  74.     frGetFieldNames(TfrTDataSet(ds), sl);
  75.     for i := 0 to sl.Count - 1 do
  76.       Result := Result + sl[i] + ';';
  77.     sl.Free;
  78.   end;
  79.  
  80.   function GetListSource: String;
  81.   var
  82.     i: Integer;
  83.     sl: TStringList;
  84.   begin
  85.     Result := '';
  86.     sl := TStringList.Create;
  87.     frGetComponents(frDialogForm, TDataSet, sl, nil);
  88.     sl.Sort;
  89.     for i := 0 to sl.Count - 1 do
  90.       Result := Result + sl[i] + ';';
  91.     sl.Free;
  92.   end;
  93.  
  94. begin
  95.   inherited DefineProperties;
  96.   AddEnumProperty('KeyField', GetFields, [Null]);
  97.   AddEnumProperty('ListField', GetFields, [Null]);
  98.   AddEnumProperty('ListSource', GetListSource, [Null]);
  99.   AddProperty('Text', [], nil);
  100. end;
  101.  
  102. procedure TfrDBLookupControl.SetPropValue(Index: String; Value: Variant);
  103. var
  104.   d: TDataset;
  105. begin
  106.   inherited SetPropValue(Index, Value);
  107.   Index := AnsiUpperCase(Index);
  108.   if Index = 'TEXT' then
  109.     FLookup.KeyValue := Value
  110.   else if Index = 'KEYFIELD' then
  111.     FLookup.KeyField := Value
  112.   else if Index = 'LISTFIELD' then
  113.     FLookup.ListField := Value
  114.   else if Index = 'LISTSOURCE' then
  115.   begin
  116.     d := frFindComponent(frDialogForm, Value) as TDataSet;
  117.     FLookup.ListSource := frGetDataSource(frDialogForm, d);
  118.   end;
  119.   FLookup.DropDownAlign := daLeft;
  120. end;
  121.  
  122. function TfrDBLookupControl.GetPropValue(Index: String): Variant;
  123. begin
  124.   Index := AnsiUpperCase(Index);
  125.   Result := inherited GetPropValue(Index);
  126.   if Result <> Null then Exit;
  127.   if Index = 'TEXT' then
  128.     Result := FLookup.KeyValue
  129.   else if Index = 'KEYFIELD' then
  130.     Result := FLookup.KeyField
  131.   else if Index = 'LISTFIELD' then
  132.     Result := FLookup.ListField
  133.   else if Index = 'LISTSOURCE' then
  134.     Result := frGetDataSetName(frDialogForm, FLookup.ListSource)
  135. end;
  136.  
  137. procedure TfrDBLookupControl.LoadFromStream(Stream: TStream);
  138. begin
  139.   inherited LoadFromStream(Stream);
  140.   FListSource := frReadString(Stream);
  141.   Prop['ListSource'] := FListSource;
  142.   Prop['KeyField'] := frReadString(Stream);
  143.   Prop['ListField'] := frReadString(Stream);
  144. end;
  145.  
  146. procedure TfrDBLookupControl.SaveToStream(Stream: TStream);
  147. begin
  148.   inherited SaveToStream(Stream);
  149.   frWriteString(Stream, Prop['ListSource']);
  150.   frWriteString(Stream, Prop['KeyField']);
  151.   frWriteString(Stream, Prop['ListField']);
  152. end;
  153.  
  154. procedure TfrDBLookupControl.Loaded;
  155. begin
  156.   Prop['ListSource'] := FListSource;
  157.   inherited Loaded;
  158. end;
  159.  
  160. var
  161.   Bmp: TBitmap;
  162.  
  163. initialization
  164.   Bmp := TBitmap.Create;
  165.   Bmp.LoadFromResourceName(hInstance, 'FR_DBLOOKUPCONTROL');
  166.   frRegisterControl(TfrDBLookupControl, Bmp, (SInsertDBLookup));
  167.  
  168. finalization
  169.   frUnRegisterObject(TfrDBLookupControl);
  170.   Bmp.Free;
  171.  
  172. end.
  173.  
  174.