aincsrch.pas

来自「delphi编程控件」· PAS 代码 · 共 528 行

unit aincsrch;
(*
 COPYRIGHT (c) RSD Software 1997 - 98
 All Rights Reserved.
*)

interface
{$I aclver.inc}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, DB, Menus, Mask, DBTables {$IFDEF DELPHI3_0}, dbctrls,
  adatectl {$ENDIF}, adbtempl;

type
TCustomAutoIncSearch = class(TComponent)
private
  FDBControl : TWinControl;
  ObjectInstance : Pointer;
  FDBControlWndProcAdd : Pointer;
  FCaseInsensitive : Boolean;
  FHotKey: TShortCut;
  FRepository : TAutoRepository;

  FieldName : String;

  procedure SetDBControl(Value : TWinControl);
protected
  procedure DBControlWndProc(var Message: TMessage);
  function GetDataSource : TDataSource; virtual;
  function GetField : TField; virtual;

  property CaseInsensitive : Boolean read FCaseInsensitive write FCaseInsensitive;
  property DataField : String read FieldName write FieldName;
  property DBControl : TWinControl read FDBControl write SetDBControl;
  property HotKey: TShortCut read FHotKey write FHotKey;
  property Repository : TAutoRepository read FRepository write FRepository;
public
  constructor Create(AOwner : TComponent); override;
  destructor Destroy; override;
  procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  function Execute : Boolean;
  procedure Refresh; 

  property DataSource : TDataSource read GetDataSource;
  property Field : TField read GetField;
end;

TAutoIncSearch = class(TCustomAutoIncSearch)
published
  property CaseInsensitive;
  property DataField;
  property DBControl;
  property HotKey;
  property Repository;
end;

TCustomAutoControlIncSearch = class(TPersistent)
private
  FCaseInsensitive : Boolean;
  FHotKey: TShortCut;
  FRepository : TAutoRepository;

protected
  function GetDBControl : TWinControl; virtual;
  function GetDataSource : TDataSource; virtual;
  function GetField : TField; virtual;

  property CaseInsensitive : Boolean read FCaseInsensitive write FCaseInsensitive;
  property HotKey: TShortCut read FHotKey write FHotKey;
  property Repository : TAutoRepository read FRepository write FRepository;
public
  constructor Create;
  destructor Destroy; override;
  procedure Assign(Source: TPersistent); override;

  function Execute : Boolean; virtual;
end;

TfdbIncSearchdlg = class(TForm)
  Panel: TPanel;
  procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
private
  FLocateControl : TWinControl;
  FDBDefControl : TAutoDBDefControl;
protected
  procedure WndProc(var Message: TMessage); override;
end;

TAutoEditLocate = class(TCustomMaskEdit)
private
  FDataLink : TFieldDataLink;
  FOptions : TLocateOptions;  
  function GetDataField: String;
  function GetDataSource: TDataSource;
  function GetField: TField;
  procedure SetDataField(const Value: String);
  procedure SetDataSource(Value: TDataSource);
protected
  procedure Change; override;
  procedure KeyPress(var Key: Char); override;
public
  constructor Create(AOwner : TComponent); override;
  destructor Destroy; override;
  procedure Notification(AComponent: TComponent;
  Operation: TOperation); override;
  property Field: TField read GetField;
published
  property AutoSize;
  property BorderStyle;
  property CharCase;
  property Color;
  property Ctl3D;
  property DataField: String read GetDataField write SetDataField;
  property DataSource: TDataSource read GetDataSource write SetDataSource;
  property DragCursor;
  property DragMode;
  property Enabled;
  property Font;
  property Options : TLocateOptions read FOptions write FOptions;
  property ParentColor;
  property ParentCtl3D;
  property ParentFont;
  property ParentShowHint;
  property PasswordChar;
  property PopupMenu;
  property ShowHint;
  property TabOrder;
  property TabStop;
  property Visible;
  property OnChange;
  property OnClick;
  property OnDblClick;
  property OnDragDrop;
  property OnDragOver;
  property OnEndDrag;
  property OnEnter;
  property OnExit;
  property OnKeyDown;
  property OnKeyPress;
  property OnKeyUp;
  property OnMouseDown;
  property OnMouseMove;
  property OnMouseUp;
  property OnStartDrag;
end;

implementation
uses aclconst, agraphic, TypInfo, adefctrl;

{$R *.DFM}
{TCustomAutoIncSearch}
constructor TCustomAutoIncSearch.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);
  ObjectInstance := MakeObjectInstance(DBControlWndProc);
  FHotKey := acDBIncControlSearsh_VK;
  FRepository := Nil;
end;

destructor TCustomAutoIncSearch.Destroy;
begin
  DBControl := Nil;
  if (ObjectInstance <> Nil) then
    FreeObjectInstance(ObjectInstance);
  inherited Destroy;
end;

procedure TCustomAutoIncSearch.DBControlWndProc(var Message: TMessage);
Var
  Key : Word;
  ShiftState1, ShiftState2 : TShiftState;
begin
  with TMessage(Message) do begin
    if (msg = WM_KEYDOWN) then begin
     ShortCutToKey(FHotKey, Key, ShiftState1);
     ShiftState2 := [];
     if (GetKeyState(VK_CONTROL) < 0) then
       ShiftState2 := ShiftState2 + [ssCtrl];
     if (GetKeyState(VK_SHIFT) < 0) then
       ShiftState2 := ShiftState2 + [ssShift];
     if (GetKeyState(VK_MENU) < 0) then
       ShiftState2 := ShiftState2 + [ssAlt];
     if (wparam = Key) And (ShiftState1 = ShiftState2) then
       Execute;
     end;
     Result := CallWindowProc(FDBControlWndProcAdd, FDBControl.Handle, Msg, WParam, LParam);
     if(msg = WM_DESTROY) then begin
       SetWindowLong(FDBControl.Handle, GWL_WNDPROC, LongInt(FDBControlWndProcAdd));
       FDBControlWndProcAdd := Nil;
     end;
   end;
end;

procedure TCustomAutoIncSearch.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited;
  if(AComponent = FDBControl) And (Operation = opRemove) then
    DBControl := Nil;
  if(AComponent = FRepository) And (Operation = opRemove) then
    Repository := Nil;
end;

function TCustomAutoIncSearch.GetDataSource : TDataSource;
Var
  pInfo : PPropInfo;
begin
  Result := Nil;
  if(FDBControl <> Nil) then begin
    pInfo := GetPropInfo(FDBControl.ClassInfo, 'DataSource');
    if(pInfo <> Nil) then
      Result := TDataSource(GetOrdProp(FDBControl, pInfo));
  end;
end;

function TCustomAutoIncSearch.GetField : TField;
Var
  pInfo : PPropInfo;
  ADS : TDataSet;
  AFieldName : String;
begin
  Result := Nil;
  if(DataSource <> Nil) And (DataSource.DataSet <> Nil)
  And (DataSource.DataSet.Active) then begin
    ADS := DataSource.DataSet;
    AFieldName := FieldName;
    if(FieldName = '') then begin
      pInfo := GetPropInfo(FDBControl.ClassInfo, 'DataField');
      if(pInfo <> Nil) And
      ((pInfo^.PropType^.Kind = tkString) Or (pInfo^.PropType^.Kind = tkLString))then
        AFieldName := GetStrProp(FDBControl, pInfo);
    end;
    if(AFieldName <> '') then
     Result := ADS.FindField(AFieldName);
  end;
end;

procedure TCustomAutoIncSearch.SetDBControl(Value : TWinControl);
Var
  pInfo : PPropInfo;
begin
  if(FDBControl = Value) And (FDBControlWndProcAdd <> Nil) then exit;
  if(Value <> Nil) then begin
    pInfo := GetPropInfo(Value.ClassInfo, 'DataSource');
    if(pInfo = Nil) then
      Value := Nil;
  end;

  if(FDBControl <> Nil) And (FDBControlWndProcAdd <> Nil)
  And Not (csDestroying in FDBControl.ComponentState)
  And (FDBControl.HandleAllocated) then begin
    SetWindowLong(FDBControl.Handle, GWL_WNDPROC, LongInt(FDBControlWndProcAdd));
    FDBControlWndProcAdd := Nil;
  end;
  FDBControl := Value;
  if(FDBControl <> Nil) And  Not (csDesigning in FDBControl.ComponentState) then begin
    FDBControlWndProcAdd := Pointer(GetWindowLong(FDBControl.Handle, GWL_WNDPROC));
    SetWindowLong(FDBControl.Handle, GWL_WNDPROC, LongInt(ObjectInstance));
  end;
end;

function TCustomAutoIncSearch.Execute : Boolean;
Var
  pUp, pDn : TPoint;
  AForm : TfdbIncSearchdlg;
  AField : TField;
  ALocateControl : TWinControl;
  ADBDefControl : TAutoDBDefControl;
  bookMark : TBookMark;
begin
  Result := False;
  AField := Field;

  if(AField = Nil) then exit;

  ADBDefControl := GetDBDefControl(FRepository, AField);
  if(ADBDefControl = Nil) then exit;
  AForm := TfdbIncSearchdlg.Create(Owner);
  ALocateControl := ADBDefControl.CreateLocateControl(AForm.Panel,
                 AField, CaseInsensitive);

  if(ALocateControl = Nil) then begin
    AForm.Free;
    exit;
  end;

  Result := True;

  bookMark := AField.DataSet.GetBookMark;
  AForm.FLocateControl := ALocateControl;
  AForm.FDBDefControl := ADBDefControl;
  ALocateControl.Visible := True;
  AForm.ClientWidth := 4 + ALocateControl.Width;
  AForm.ClientHeight := 4 + ALocateControl.Height;
  ALocateControl.Align := alClient;

  pDn.X := 0;
  pDn.Y := DBControl.Height;
  pDn := DBControl.ClientToScreen(pDn);
  pUp.X := 0;
  pUp.Y := 0;
  pUp := DBControl.ClientToScreen(pUp);

  if(pDn.X > 0) then
    AForm.Left := pDn.X
  else AForm.Left := 0;
  if(AForm.Left + AForm.Width > Screen.Width) then
    AForm.Left := Screen.Width - AForm.Width;
  if(pDn.Y < Screen.Height - AForm.Height) then
    AForm.Top := pDn.Y
  else begin
    if(pUp.Y > AForm.Height) then
      AForm.Top := pUp.Y - AForm.Height
    else AForm.Top := Screen.Height - AForm.Height;
  end;

  AForm.ShowModal;
  if(AForm.Modalresult = mrCancel) then
    AField.DataSet.GotoBookMark(bookMark);
  AField.DataSet.FreeBookMark(bookMark);


  AForm.Free;
end;

procedure TCustomAutoIncSearch.Refresh;
begin
  SetDBControl(FDBControl);
end;

{TCustomAutoControlIncSearch}
constructor TCustomAutoControlIncSearch.Create;
begin
  inherited;
  FHotKey := acDBIncControlSearsh_VK;
end;

destructor TCustomAutoControlIncSearch.Destroy;
begin
  inherited Destroy;
end;

procedure TCustomAutoControlIncSearch.Assign(Source: TPersistent);
Var
 AIncS : TCustomAutoControlIncSearch;
begin
  if(Source is TCustomAutoControlIncSearch) then begin
    AIncS := TCustomAutoControlIncSearch(Source);
    CaseInsensitive := AIncS.CaseInsensitive;
    HotKey := AIncS.HotKey;
    Repository := AIncS.Repository;
  end else inherited Assign(Source);
end; 

function TCustomAutoControlIncSearch.GetDBControl : TWinControl;
begin
  Result := Nil;
end;

function TCustomAutoControlIncSearch.GetDataSource : TDataSource;
begin
  Result := Nil;
end;

function TCustomAutoControlIncSearch.GetField : TField;
begin
  Result := Nil;
end;

type
TAutoDBControlIncSearch = class(TAutoIncSearch)
private
  FOwner : TCustomAutoControlIncSearch;
protected
  function GetDataSource : TDataSource; override;
  function GetField : TField; override;
end;

function TAutoDBControlIncSearch.GetDataSource : TDataSource;
begin
  Result := FOwner.GetDataSource;
end;

function TAutoDBControlIncSearch.GetField : TField;
begin
  Result := FOwner.GetField;
end;

function TCustomAutoControlIncSearch.Execute : Boolean;
Var
  AIncSearch : TAutoDBControlIncSearch;
begin
  AIncSearch := TAutoDBControlIncSearch.Create(GetDBControl);
  AIncSearch.FOwner := self;
  AIncSearch.FDBControl := GetDBControl;
  AIncSearch.CaseInsensitive := CaseInsensitive;
  AIncSearch.Repository := Repository;
  Result := AIncSearch.Execute;
  AIncSearch.Free;
end;

{TfdbIncSearchdlg}
procedure TfdbIncSearchdlg.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if(Key = VK_ESCAPE) then
    ModalResult := mrCancel;
  if(Key = VK_RETURN) then
    ModalResult := mrOk;
end;

procedure TfdbIncSearchdlg.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  if(FDBDefControl <> Nil) And (FLocateControl <> Nil) then begin
    FDBDefControl.DestroyControl(FLocateControl);
    FDBDefControl := Nil;
    FLocateControl := Nil;
  end;  
end;

procedure TfdbIncSearchdlg.WndProc(var Message: TMessage);
Var
{$IFDEF DELPHI3_0}
  Form : TCustomForm;
{$ELSE}
  Form : TForm;
{$ENDIF}
begin
  if(Message.Msg = WM_NCACTIVATE)
  And (Owner <> Nil) And (Owner is TWinControl) then begin
    if (Message.wParam = LongInt(True)) then begin
      {$IFDEF DELPHI3_0}
      if (Owner is TCustomForm) then
        Form := TCustomForm(Owner)
      {$ELSE}
      if (Owner is TForm) then
        Form := TForm(Owner)
      {$ENDIF}
      else Form := GetParentForm(TWinControl(Owner));
      if(Form <> Nil) then
         SendMessage(Form.Handle, WM_NCACTIVATE, LongInt(True), 0);
    end;  
    Message.wParam := LongInt(True);
    Message.Result := DefWindowProc(Handle, Message.Msg, Message.wParam, Message.lParam);
    exit;
  end;
  inherited;
end;


constructor TAutoEditLocate.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle + [csReplicatable];
  FDataLink := TFieldDataLink.Create;
  FDataLink.Control := Self;
  FOptions := [loCaseInsensitive, loPartialKey];
end;

destructor TAutoEditLocate.Destroy;
begin
  FDataLink.Free;
  FDataLink := nil;
  inherited Destroy;
end;

procedure TAutoEditLocate.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) And (FDataLink <> Nil)
  And (AComponent = DataSource) then DataSource := Nil;
end;

procedure TAutoEditLocate.Change;
begin
  inherited Change;
  if(FDataLink.Field <> Nil) then begin
    if(FDataLink.Field.DataType = ftString) then
      MaxLength := FDataLink.Field.DisplayWidth
    else MaxLength := 0;
    if (Text <> '') then begin
      FDataLink.DataSet.Locate(FDataLink.Field.FieldName, Text, FOptions);
    end;
  end;
end;

procedure TAutoEditLocate.KeyPress(var Key: Char);
begin
  if (Key in [#32..#255]) And (FDataLink.Field <> Nil)
  And not FDataLink.Field.IsValidChar(Key) then begin
    MessageBeep(0);
    Key := #0;
  end;
  inherited KeyPress(Key);
end;

function TAutoEditLocate.GetDataSource: TDataSource;
begin
  Result := FDataLink.DataSource;
end;

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

function TAutoEditLocate.GetDataField: string;
begin
  Result := FDataLink.FieldName;
end;

procedure TAutoEditLocate.SetDataField(const Value: string);
begin
  FDataLink.FieldName := Value;
end;

function TAutoEditLocate.GetField: TField;
begin
  Result := FDataLink.Field;
end;

end.