home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 December / Chip_2001-12_cd1.bin / zkuste / delphi / kolekce / d456 / VOLGAPAK.ZIP / Source / VolFndEd.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2001-04-15  |  7.4 KB  |  270 lines
  1. unit VolFndEd;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  7.   StdCtrls, extctrls, DB, dbctrls;
  8.  
  9. type
  10.   TVolgaFindStyle = (vfsNavigate, vfsFilter);
  11.   TVolgaFindMode = (vfmFirstPos, vfmAnyPos);
  12.  
  13.   TVolgaFindEdit = class(TCustomEdit)
  14.   private
  15.     { Private declarations }
  16.     FTimer: TTimer;
  17.     FOldFiltered: Boolean;
  18.     FOldFilterRecord: TFilterRecordEvent;
  19.     FDataLink: TFieldDataLink;
  20.     FIgnoreCase: Boolean;
  21.     FFindMode: TVolgaFindMode;
  22.     FFindStyle: TVolgaFindStyle;
  23.     FSearchText: string;
  24.     procedure ActiveChange(Sender: TObject);
  25.     function GetDataField: string;
  26.     function GetDataSource: TDataSource;
  27.     procedure SetDataField(const Value: string);
  28.     procedure SetDataSource(const Value: TDataSource);
  29.     procedure SetFindMode(const Value: TVolgaFindMode);
  30.     procedure SetFindStyle(const Value: TVolgaFindStyle);
  31.     procedure SetIgnoreCase(const Value: Boolean);
  32.     procedure FTimerTimer(Sender: TObject);
  33.     procedure AFilterRecord(DataSet: TDataSet;
  34.       var Accept: Boolean);
  35.   protected
  36.     { Protected declarations }
  37.     procedure Change; override;
  38.     procedure Notification(AComponent: TComponent;
  39.       Operation: TOperation); override;
  40.   public
  41.     { Public declarations }
  42.     constructor Create(AOwner: TComponent); override;
  43.     destructor Destroy; override;
  44.     procedure Find(AText: string);
  45.   published
  46.     { Published declarations }
  47.     property DataField: string read GetDataField write SetDataField;
  48.     property DataSource: TDataSource read GetDataSource write SetDataSource;
  49.     property FindStyle: TVolgaFindStyle read FFindStyle write SetFindStyle default
  50.       vfsNavigate;
  51.     property FindMode: TVolgaFindMode read FFindMode write SetFindMode default vfmFirstPos;
  52.     property IgnoreCase: Boolean read FIgnoreCase write SetIgnoreCase default true;
  53.     property Anchors;
  54.     property AutoSelect;
  55.     property AutoSize;
  56.     property BorderStyle;
  57.     property CharCase;
  58.     property Color;
  59.     property Constraints;
  60.     property Ctl3D;
  61.     property DragCursor;
  62.     property Enabled;
  63.     property Font;
  64.     property HideSelection;
  65.     property MaxLength;
  66.     property ParentColor;
  67.     property ParentCtl3D;
  68.     property ParentFont;
  69.     property ParentShowHint;
  70.     property PasswordChar;
  71.     property PopupMenu;
  72.     property ReadOnly;
  73.     property ShowHint;
  74.     property TabOrder;
  75.     property TabStop;
  76.     property Visible;
  77.     property OnChange;
  78.     property OnClick;
  79.     property OnDblClick;
  80.     property OnDragDrop;
  81.     property OnDragOver;
  82.     property OnEndDock;
  83.     property OnEndDrag;
  84.     property OnEnter;
  85.     property OnExit;
  86.     property OnKeyDown;
  87.     property OnKeyPress;
  88.     property OnKeyUp;
  89.     property OnMouseDown;
  90.     property OnMouseMove;
  91.     property OnMouseUp;
  92.     property OnStartDock;
  93.     property OnStartDrag;
  94.   end;
  95.  
  96. procedure Register;
  97.  
  98. implementation
  99.  
  100. procedure Register;
  101. begin
  102.   RegisterComponents('Volga', [TVolgaFindEdit]);
  103. end;
  104.  
  105. { TVolgaFindEdit }
  106.  
  107. constructor TVolgaFindEdit.Create(AOwner: TComponent);
  108. begin
  109.   inherited;
  110.   FFindStyle := vfsNavigate;
  111.   FFindMode := vfmFirstPos;
  112.   FIgnoreCase := true;
  113.   FTimer := TTimer.Create(Self);
  114.   FTimer.Enabled := false;
  115.   FTimer.Interval := 100;
  116.   FTimer.OnTimer := FTimerTimer;
  117.   FSearchText := '';
  118.   FOldFiltered := false;
  119.   FOldFilterRecord := nil;
  120.   FDataLink := TFieldDataLink.Create;
  121.   FDataLink.Control := Self;
  122.   FDataLink.OnActiveChange := ActiveChange;
  123. end;
  124.  
  125. destructor TVolgaFindEdit.Destroy;
  126. begin
  127.   if FDataLink.Active and (FFindStyle = vfsFilter) then begin
  128.     FDataLink.DataSet.OnFilterRecord := FOldFilterRecord;
  129.     FDataLink.DataSet.Filtered := FOldFiltered;
  130.   end;
  131.   FDataLink.Control := nil;
  132.   FDataLink.Free;
  133.   FDataLink := nil;
  134.   inherited;
  135. end;
  136.  
  137. procedure TVolgaFindEdit.Change;
  138. begin
  139.   FTimer.Enabled := false;               //ε±≥αφεΓΦ≥ⁿ ∩≡σΣ√Σ.≥αΘ∞σ≡
  140.   FTimer.Enabled := true;
  141.   FSearchText := Text;
  142.   inherited;
  143. end;
  144.  
  145. procedure TVolgaFindEdit.FTimerTimer(Sender: TObject);
  146. begin
  147.   FTimer.Enabled := false;
  148.   ActiveChange(Self);
  149.   if FSearchText='' then
  150.     if FFindStyle = vfsFilter then begin
  151.       FDataLink.DataSet.OnFilterRecord := FOldFilterRecord;
  152.       FDataLink.DataSet.Filtered := FOldFiltered;
  153.     end else
  154.   else    //Γ√∩εδφΦ≥ⁿ ∩εΦ±Ω ∩ε±δσ ταΣσ≡µΩΦ
  155.   begin
  156.     if not FDataLink.Active or (FDataLink.Field = nil) then Exit;
  157.     if FFindStyle = vfsNavigate then
  158.       if IgnoreCase then
  159.         FDataLink.DataSet.Locate(DataField, FSearchText, [loCaseInsensitive, loPartialKey])
  160.       else
  161.         FDataLink.DataSet.Locate(DataField, FSearchText, [loPartialKey])
  162.     else
  163.       FDataLink.DataSet.Filtered := true;
  164.   end;
  165. end;
  166.  
  167. procedure TVolgaFindEdit.Find(AText: string);
  168. begin
  169.   FSearchText := AText;
  170.   FTimerTimer(FTimer);
  171. end;
  172.  
  173. procedure TVolgaFindEdit.AFilterRecord(DataSet: TDataSet;
  174.   var Accept: Boolean);
  175. begin
  176.   Accept := true;
  177.   if FOldFiltered and Assigned(FOldFilterRecord) then
  178.     FOldFilterRecord(DataSet, Accept);
  179.   if not Accept then Exit;
  180.   if FFindMode = vfmFirstPos then
  181.     if IgnoreCase then
  182.       Accept := Pos(AnsiUpperCase(FSearchText),
  183.         AnsiUpperCase(DataSet.FieldByName(DataField).AsString)) = 1
  184.     else
  185.       Accept := Pos(FSearchText, DataSet.FieldByName(DataField).AsString) = 1
  186.   else if IgnoreCase then
  187.     Accept := Pos(AnsiUpperCase(FSearchText),
  188.       AnsiUpperCase(DataSet.FieldByName(DataField).AsString)) > 0
  189.   else
  190.     Accept := Pos(FSearchText, DataSet.FieldByName(DataField).AsString) > 0
  191. end;
  192.  
  193. procedure TVolgaFindEdit.ActiveChange(Sender: TObject);
  194. var Func1,Func2:TFilterRecordEvent;
  195. begin
  196.   if (FFindStyle = vfsNavigate) or (FDataLink.DataSet = nil) then Exit;
  197.   Func1 := FDataLink.DataSet.OnFilterRecord;
  198.   Func2 := AFilterRecord;
  199.   if FDataLink.Active and (@Func1 <> @Func2) and (FSearchText>'') then
  200.   begin
  201.     FOldFilterRecord := FDataLink.DataSet.OnFilterRecord;
  202.     FOldFiltered := FDataLink.DataSet.Filtered;
  203.     FDataLink.DataSet.OnFilterRecord := AFilterRecord;
  204. {  end
  205.   else
  206.   begin
  207.     FOldFiltered := false;
  208.     FOldFilterRecord := nil;}
  209.   end;
  210. end;
  211.  
  212. function TVolgaFindEdit.GetDataSource: TDataSource;
  213. begin
  214.   Result := FDataLink.DataSource;
  215. end;
  216.  
  217. procedure TVolgaFindEdit.SetDataSource(const Value: TDataSource);
  218. begin
  219.   if not (FDataLink.DataSourceFixed and (csLoading in ComponentState)) then
  220.     FDataLink.DataSource := Value;
  221.   if Value <> nil then Value.FreeNotification(Self);
  222. end;
  223.  
  224. function TVolgaFindEdit.GetDataField: string;
  225. begin
  226.   Result := FDataLink.FieldName;
  227. end;
  228.  
  229. procedure TVolgaFindEdit.SetDataField(const Value: string);
  230. begin
  231.   if Value > '' then
  232.     FDataLink.FieldName := Value;
  233. end;
  234.  
  235. procedure TVolgaFindEdit.SetFindMode(const Value: TVolgaFindMode);
  236. begin
  237.   if FFindStyle = vfsNavigate then
  238.     FFindMode := vfmFirstPos
  239.   else
  240.     FFindMode := Value;
  241. end;
  242.  
  243. procedure TVolgaFindEdit.SetFindStyle(const Value: TVolgaFindStyle);
  244. begin
  245.   FFindStyle := Value;
  246.   if FFindStyle = vfsNavigate then FFindMode := vfmFirstPos;
  247.   ActiveChange(Self);
  248. end;
  249.  
  250. procedure TVolgaFindEdit.SetIgnoreCase(const Value: Boolean);
  251. begin
  252.   FIgnoreCase := Value;
  253. end;
  254.  
  255. procedure TVolgaFindEdit.Notification(AComponent: TComponent;
  256.   Operation: TOperation);
  257. begin
  258.   inherited Notification(AComponent, Operation);
  259.   if Operation = opRemove then
  260.   begin
  261.     if (FDataLink <> nil) and (AComponent = DataSource) then
  262.     begin
  263.       DataSource := nil;
  264.     end;
  265.   end;
  266. end;
  267.  
  268. end.
  269.  
  270.