{----------------------------------------------------------------------------- The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at http://www.mozilla.org/MPL/MPL-1.1.html Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for the specific language governing rights and limitations under the License. The Original Code is: JvDBSearchEdit.pas, released on 2004-02-28. The Initial Developer of the Original Code is Lionel Reynaud Portions created by Sébastien Buysse are Copyright (C) 2004 Lionel Reynaud. All Rights Reserved. Contributor(s): You may retrieve the latest version of this file at the Project JEDI's JVCL home page, located at http://jvcl.delphi-jedi.org Known Issues: Description: // DB Component to find record with Edit // Free modified and corrected component TDBSearchEdit from Alexander Burlakov -----------------------------------------------------------------------------} // $Id$ unit JvDBSearchEdit; {$mode objfpc}{$H+} interface uses LCLType, LCLIntf, LMessages, Classes, Controls, StdCtrls, DB, DBCtrls; type TJvDBCustomSearchEdit = class(TCustomEdit) //JvCustomEdit) private FDataLink: TFieldDataLink; FSearchOptions: TLocateOptions; FClearOnEnter: Boolean; FDataResult: string; FRaiseLocateException: Boolean; procedure DataChange(Sender: TObject); function GetDataSource: TDataSource; function GetDataField: string; procedure SetDataSource(Value: TDataSource); procedure SetDataField(const Value: string); procedure SetSearchOptions(const Value: TLocateOptions); procedure CMChanged(var {%H-}Msg: TLMessage); message CM_CHANGED; protected procedure DoEnter; override; procedure DoExit; override; procedure KeyPress(var Key: Char); override; procedure Notification(Component: TComponent; Operation: TOperation); override; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; function GetResult: Variant; property SearchOptions: TLocateOptions read FSearchOptions write SetSearchOptions default [loCaseInsensitive, loPartialKey]; published property DataSource: TDataSource read GetDataSource write SetDataSource; property DataResult: string read FDataResult write FDataResult; property DataField: string read GetDataField write SetDataField; property TabStop default True; property ClearOnEnter: Boolean read FClearOnEnter write FClearOnEnter default True; //1 Property to raise/hide any exception inside the Dataset.Locate call property RaiseLocateException: Boolean read FRaiseLocateException write FRaiseLocateException default true; end; {$IFDEF RTL230_UP} [ComponentPlatformsAttribute(pidWin32 or pidWin64)] {$ENDIF RTL230_UP} TJvDBSearchEdit = class(TJvDBCustomSearchEdit) published property SearchOptions default [loCaseInsensitive, loPartialKey]; property Align; property Alignment; property Anchors; property AutoSelect; property AutoSize; // property BevelEdges; // property BevelInner; // property BevelKind default bkNone; // property BevelOuter; property BiDiMode; property BorderSpacing; property BorderStyle; property CharCase; property Color; property Constraints; property Cursor; // property Flat; property DragCursor; property DragKind; // property ImeMode; // property ImeName; // property OEMConvert; // property ParentFlat; property DragMode; property Enabled; property Font; property Height; property HelpContext; property HelpKeyword; property HelpType; property HideSelection; property Hint; property MaxLength; property NumbersOnly; property ParentBiDiMode; property ParentColor; property ParentFont; property ParentShowHint; property PopupMenu; property ReadOnly; property ShowHint; property TabOrder; property TabStop; property Text; property TextHint; property Top; property Visible; property Width; property OnChange; property OnChangeBounds; property OnClick; property OnContextPopup; property OnDblClick; property OnDragDrop; property OnDragOver; property OnEditingDone; property OnEndDrag; property OnEnter; property OnExit; property OnKeyDown; property OnKeyPress; property OnKeyUp; property OnMouseDown; property OnMouseEnter; property OnMouseLeave; property OnMouseMove; property OnMouseUp; property OnMouseWheel; property OnMouseWheelDown; property OnMouseWheelUp; property OnResize; property OnStartDrag; property OnUTF8KeyPress; end; implementation uses Variants, Forms, JvConsts; //=== { TJvDBCustomSearchEdit } ============================================== constructor TJvDBCustomSearchEdit.Create(AOwner: TComponent); begin inherited Create(AOwner); FDataLink := TFieldDataLink.Create; FDataLink.Control := Self; FDataLink.OnDataChange := @DataChange; FSearchOptions := [loCaseInsensitive, loPartialKey]; FClearOnEnter := True; Text := ''; FRaiseLocateException := True; end; destructor TJvDBCustomSearchEdit.Destroy; begin FDataLink.Free; FDataLink := nil; inherited Destroy; end; procedure TJvDBCustomSearchEdit.Notification(Component: TComponent; Operation: TOperation); begin inherited Notification(Component, Operation); if (FDataLink <> nil) and (Component = DataSource) and (Operation = opRemove) then DataSource := nil; end; procedure TJvDBCustomSearchEdit.DataChange(Sender: TObject); begin if FDataLink.Field <> nil then begin if Screen.ActiveControl <> Self then begin if FDataLink.CanModify then Text := FDataLink.Field.Text else Text := FDataLink.Field.DisplayText; SelectAll; end; end else begin if csDesigning in ComponentState then Text := Name else Text := ''; end; end; procedure TJvDBCustomSearchEdit.CMChanged(var Msg: TLMessage); var LText: string; begin if (not ((csDesigning in ComponentState) and (csLoading in ComponentState))) and Assigned(FDataLink.DataSet) then if (Screen.ActiveControl = Self) and FDataLink.Active then try if FDataLink.DataSet.Locate(FDataLink.FieldName, Text, FSearchOptions) then begin LText := Text; Text := FDataLink.DataSet.FieldByName(DataField).AsString; SelStart := Length(LText); SelLength := Length(Text) - SelStart; end; except if RaiseLocateException then raise; end; end; procedure TJvDBCustomSearchEdit.KeyPress(var Key: Char); var LLength: Integer; begin if Key = Backspace then begin LLength := SelLength; SelStart := SelStart - 1; SelLength := LLength + 1; end; inherited KeyPress(Key); end; function TJvDBCustomSearchEdit.GetDataSource: TDataSource; begin Result := FDataLink.DataSource; end; procedure TJvDBCustomSearchEdit.SetDataSource(Value: TDataSource); begin FDataLink.DataSource := Value; end; function TJvDBCustomSearchEdit.GetDataField: string; begin Result := FDataLink.FieldName; end; procedure TJvDBCustomSearchEdit.SetDataField(const Value: string); begin FDataLink.FieldName := Value; end; procedure TJvDBCustomSearchEdit.SetSearchOptions(const Value: TLocateOptions); begin FSearchOptions := Value; end; function TJvDBCustomSearchEdit.GetResult: Variant; begin Result := Null; if Assigned(FDataLink.DataSet) and FDataLink.DataSet.Active and (DataResult <> '') then Result := FDataLink.DataSet.Lookup(DataField, Text, DataResult); end; procedure TJvDBCustomSearchEdit.DoEnter; begin if FClearOnEnter then Text := ''; inherited DoEnter; end; procedure TJvDBCustomSearchEdit.DoExit; begin inherited DoExit; // On replace le texte sur l'enregistrement en cours if Assigned(FDataLink.DataSet) and FDataLink.DataSet.Active then Text := FDataLink.DataSet.FieldByName(DataField).AsString; end; {$IFDEF UNITVERSIONING} initialization RegisterUnitVersion(HInstance, UnitVersioning); finalization UnregisterUnitVersion(HInstance); {$ENDIF UNITVERSIONING} end.