ROOT:\SRC\>type DBLookUpLocateComboBox.txt

unit DBLookupLocateComboBox;
{
   DBLookUpComboBox with locate function
   (c) Guriy (Gorunov Juriy A. 2000)
    mailto:guriy@ukrpost.kiev.ua
    http://guriy.narod.ru
{}
interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  DBCtrls, stdctrls, db;

type
  TDBLookupLocateComboBox = class(TDBLookupComboBox)
private
{ Private declarations }
FLocateString: String;
FDisplayLSLabel: TLabel;
FColorHighLightSearch: Boolean;
FColorHighLightOk: TColor;
FColorHighLightNoOk: TColor;
FColorHighLightEmpty: TColor;
FSetEmptyText: boolean;
FSetEmptyTextValue: string;
procedure SetLocateString(Value: string);
function GetLocateString: string;
procedure SetDisplayLSLabel(Value: TLabel);
procedure SetColorHighLightSearch(Value: Boolean);
procedure SetColorHighLightOk(Value: TColor);
procedure SetColorHighLightNoOk(Value: TColor);
procedure SetColorHighLightEmpty(Value: TColor);
procedure SetSetEmptyText(Value: boolean);
procedure SetSetEmptyTextValue(Value: String);
protected
{ Protected declarations }
procedure KeyPress(var Key: Char); override;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure DoEnter; override;
procedure DoExit; override;
constructor Create(AOwner: TComponent); override;
public
{ Public declarations }
published
{ Published declarations }
property LocateString: string read GetLocateString write SetLocateString;
property DisplayLSLabel: TLabel read FDisplayLSLabel write SetDisplayLSLabel;
property ColorHighLightSearch: boolean read FColorHighLightSearch write  SetColorHighLightSearch;
property ColorHighLightOk: TColor read FColorHighLightOk write SetColorHighLightOk;
property ColorHighLightNoOk: TColor read FColorHighLightNoOk write SetColorHighLightNoOk;
property ColorHighLightEmpty: TColor read FColorHighLightEmpty write SetColorHighLightEmpty;
property SetEmptyText: boolean read FSetEmptyText write SetSetEmptyText;
property SetEmptyTextValue: string read FSetEmptyTextValue write SetSetEmptyTextValue;
property OnKeyPress;
property OnKeyDown;
property OnEnter;
property OnExit;
end;

procedure Register;

implementation

procedure TDBLookupLocateComboBox.SetLocateString(Value: string);
begin
FLocateString:=Value;
if Assigned(FDisplayLSLabel) then begin
if FLocateString<>'' then begin
DisplayLSLabel.Caption:=FLocateString;
if Assigned(DataSource) then
if Assigned(DataSource.DataSet) then
if DataField<> '' then
if Assigned(ListSource) then
if Assigned(ListSource.DataSet) then
if ListField <> '' then begin
if KeyField <> '' then
if ListSource.DataSet.Locate(ListField, Value, [loPartialKey]) then begin
if not (DataSource.DataSet.State in [dsEdit, dsInsert]) then DataSource.DataSet.Edit;
DataSource.DataSet.FieldByName(DataField).Value:=ListSource.DataSet.FieldByName(KeyField).Value;
if ColorHighLightSearch then DisplayLSLabel.Font.Color:= ColorHighLightOk;
end else if ColorHighLightSearch then DisplayLSLabel.Font.Color:= ColorHighLightNoOk;
end;
end else begin
if SetEmptyText then DisplayLSLabel.Caption:=SetEmptyTextValue else DisplayLSLabel.Caption:='';
if ColorHighLightSearch then DisplayLSLabel.Font.Color:=ColorHighLightEmpty;
end;
end;
end;

function TDBLookupLocateComboBox.GetLocateString: string;
begin
Result:=FLocateString;
end;

procedure TDBLookupLocateComboBox.SetDisplayLSLabel(Value : TLabel);
begin
FDisplayLSLabel:=Value;
end;

procedure TDBLookupLocateComboBox.KeyPress(var Key: Char);
begin
if (Key>=' ') and (Key<='ÿ') then begin
LocateString:=LocateString+Key;
Key:=#0;
end;
inherited KeyPress(Key);
end;

procedure TDBLookupLocateComboBox.KeyDown(var Key: Word; Shift: TShiftState);
begin
if Key = 27 then begin
LocateString :='';
Key:=0;
end;
if Key = 8 then begin
LocateString :=Copy(LocateString, 1,Length(LocateString)-1);
Key:=0;
end;
inherited KeyDown(Key, Shift);
end;

procedure TDBLookupLocateComboBox.SetColorHighLightSearch(Value: Boolean);
begin
FColorHighLightSearch:=Value;
end;

procedure TDBLookupLocateComboBox.SetColorHighLightOk(Value: TColor);
begin
FColorHighLightOk:=Value
end;

procedure TDBLookupLocateComboBox.SetColorHighLightNoOk(Value: TColor);
begin
FColorHighLightNoOk:=Value
end;

procedure TDBLookupLocateComboBox.SetColorHighLightEmpty(Value: TColor);
begin
FColorHighLightEmpty:=Value
end;

procedure TDBLookupLocateComboBox.SetSetEmptyText(Value: boolean);
begin
FSetEmptyText:=Value
end;

procedure TDBLookupLocateComboBox.SetSetEmptyTextValue(Value: String);
begin
FSetEmptyTextValue:=Value
end;

procedure TDBLookupLocateComboBox.DoEnter;
begin
SetLocateString(LocateString);
inherited DoEnter;
end;

procedure TDBLookupLocateComboBox.DoExit;
begin
LocateString:=Self.Text;
inherited DoExit;
end;

constructor TDBLookupLocateComboBox.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ColorHighLightSearch:=True;
ColorHighLightOk:=clGreen;
ColorHighLightNoOk:=clRed;
ColorHighLightEmpty:=clWindowText;
SetEmptyText:=False;
SetEmptyTextValue:='Search string is empty';
end;

procedure Register;
begin
RegisterComponents('GuriyDBTools', [TDBLookupLocateComboBox]);
end;

end. 

ROOT:\SRC\>_

Гостевая книга и  Мыло к Вашим услугам

Благодарю www.narod.ru за размещение ресурса