refer.pas

来自「delphi编程控件」· PAS 代码 · 共 1,503 行 · 第 1/3 页

unit Refer;
(*
 COPYRIGHT (c) RSD software 1997 - 98
 All Rights Reserved.
*)

interface
{$I aclver.inc}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   DB, DBTables, ExtCtrls, Mask, Buttons, StdCtrls, DBCtrls, afilter, adbgrid,
   adbtempl;

type
TReferencePanel = class;

TAlignReferenceText = (rtLeft, rtRight);
TCustomReference = class;

TRefMaskEdit = class(TCustomMaskEdit)
private
  FCustomReference : TCustomReference;

  procedure SetEditRect;
  procedure WMSize( var Message: TWMSize ); message WM_SIZE;
  procedure DoOnChange(Sender : TObject);
protected
  procedure CreateWnd; override;
public
  BitBtn : TBitBtn;

  constructor  Create(AOwner : TComponent); override;
  destructor Destroy; override;
  procedure CreateParams( var Params: TCreateParams ); override;
  property EditMask;
  property MaxLength;
  property OnKeyDown;
  property OnKeyPress;
end;

TReferenceListSourceLink = class(TDataLink)
private
  FCustomReference: TCustomReference;
protected
  procedure ActiveChanged; override;
  procedure DataSetChanged; override;
end;

TReferenceState = (rsInvalided, rsNulled, rsValided);
TReferenceAlign = (ralTop, ralBottom, ralLeft, ralRight); 

TCustomReference = class(TCustomControl)
private
  FAlignText : TAlignReferenceText;
  FGridLayout : TAutoGridLayout;
  FAutoFilter : TAutoFilter;
  FAssignFieldName  : String;
  FDataBaseName : TFileName;
  FKeyFieldName  : String;
  FListLink : TReferenceListSourceLink;
  FPatternText : String;
  FQuery : TQuery;
  FUseQuery : Boolean;
  FReferencePanel : TReferencePanel;
  FReferencePanelAlign : TReferenceAlign;
  FTableName : TFileName;
  FTextOnError : String;
  FVisibleText : Boolean;
  FCanUseQuery : Boolean;
  FWinHeight : Integer;
  FWinWidth : Integer;
  FOnChange : TNotifyEvent;

  function GetCanUseQuery : Boolean;
  function GetEditColor : TColor;
  function GetEditWidth : Integer;
  function GetFont : TFont;
  function GetFontText : TFont;
  function GetGlyph : TBitmap;
  function GetLabelColor : TColor;
  function GetNumGlyphs : Integer;
  function GetRepository : TAutoRepository;
  function GetText : String;
  procedure SetAlignText(Value : TAlignReferenceText);
  procedure SetAssignField(Value : String);
  procedure SetEditColor(Value : TColor);
  procedure SetEditWidth(Value : Integer);
  procedure SetFont(Value : TFont);
  procedure SetFontText(Value : TFont);
  procedure SetGlyph(Value : TBitmap);
  procedure SetGridLayout(Value : TAutoGridLayout);
  procedure SetKeyField(Value : String);
  procedure SetLabelColor(Value : TColor);
  procedure SetNumGlyphs(Value : Integer);
  procedure SetPatternText(value : String);
  procedure SetReferencePanel(Value : TReferencePanel);
  procedure SetRepository(Value : TAutoRepository);
  procedure SetText(Value : String);
  procedure SetVisibleText(Value : Boolean);
  procedure SetWinHeight(Value : Integer);
  procedure SetWinWidth(Value : Integer);

  procedure BitBtnClick(Sender : TObject);
  procedure InitQuery;
  procedure ListLinkActiveChanged;
  procedure ListLinkDataChanged;
  procedure ListSourceChanged(Sender : TObject);
  procedure SetObjectsInPlace;
  procedure TryUseQuery(FChangeAssignField : Boolean; V : Variant);
  procedure WMSize( var Message: TWMSize ); message WM_SIZE;
protected
  FAssignField : TField;
  MaskEdit : TRefMaskEdit;
  LabelPanel : TPanel;
  FKeyField : TField;
  FLabel : TLabel;
  FAssignQueryField : TField;
  FKeyQueryField : TField;

  procedure DoOnChange(FState : TReferenceState); virtual;
  function GetDataTypedValue(V : Variant) : Variant;
  procedure Loaded; override;
  property AssignField  : String read FAssignFieldName write SetAssignField;
public
  State : TReferenceState;

  constructor  Create(AOwner : TComponent); override;
  destructor Destroy; override;
  procedure Notification(AComponent: TComponent; Operation: TOperation); override;

  function ChangeTextByPattern(St : String) : String;
  function GetQuery : TQuery;
  function FindByKeyFieldInList(V : Variant) : Boolean;
  function FindByKeyField(V : Variant; FChangeAssignField : Boolean) : Boolean;

  procedure GotoKeyFieldValue;
  procedure RefreshText;

  property CanUseQuery : Boolean read GetCanUseQuery;
published
  property AlignText : TAlignReferenceText read FAlignText write SetAlignText;
  {VisibleText should be declare before EditWidth}
  property VisibleText : Boolean read FVisibleText write SetVisibleText;
  property EditColor : TColor read GetEditColor write SetEditColor;
  property EditWidth : Integer read GetEditWidth write SetEditWidth;
  property Font : TFont read GetFont write SetFont;
  property FontText : TFont read GetFontText write SetFontText;
  property GridLayout : TAutoGridLayout read FGridLayout write SetGridLayout;
  property Glyph : TBitmap read GetGlyph write SetGlyph;
  property KeyField  : String read FKeyFieldName write SetKeyField;
  property LabelColor : TColor read GetLabelColor write SetLabelColor;
  property NumGlyphs : Integer read GetNumGlyphs write SetNumGlyphs;
  property PatternText : String read FPatternText write SetPatternText;
  property ReferencePanel : TReferencePanel read FReferencePanel
                                 write SetReferencePanel;
  property ReferencePanelAlign : TReferenceAlign read FReferencePanelAlign
           write FReferencePanelAlign;                              
  property Repository : TAutoRepository read GetRepository write SetRepository;
  property SQLOrderFilter : TAutoFilter read FAutoFilter write FAutoFilter;
  property TableName : TFileName read FTableName write FTableName;
  property Text : String read GetText write SetText;
  property TextOnError : String read FTextOnError write FTextOnError;
  property UseQuery : Boolean read FUseQuery write FUseQuery;
  property WinHeight : Integer read FWinHeight write SetWinHeight;
  property WinWidth : Integer read FWinWidth write SetWinWidth;
  property OnChange : TNotifyEvent read FOnChange write FOnChange;
  property Align;
  property Enabled;
  property TabOrder;
  property Visible;
  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;

TReference = class(TCustomReference)
private
  function GetEditMask : String;
  procedure SetEditMask(value : String);
published
  property EditMask : String read GetEditMask write SetEditMask;
end;

TDBReference = class(TCustomReference)
private
  FDataLink : TFieldDataLink;
  FErrorValue : String;

  function GetDataField : String;
  function GetDataSource : TDataSource;

  procedure SetDataField(Value : String);
  procedure SetDataSource(Value : TDataSource);
  procedure SetErrorValue(Value : String);

  procedure DataChange(Sender: TObject);
protected
  procedure DoOnChange(FState : TReferenceState); override;
  procedure DoKeyPress(Sender: TObject; var Key: Char);
public
  constructor  Create(AOwner : TComponent); override;
  destructor Destroy; override;
  procedure Notification(AComponent: TComponent; Operation: TOperation); override;
published
  property AssignField;
  property DataField : String read GetDataField write SetDataField;
  property DataSource : TDataSource read GetDataSource write SetDataSource;
  property ErrorValue : String read FErrorValue write SetErrorValue;
end;


TReferencePanelStyle = (bpStandart, bpComponent);

TReferencePanel = class (TCustomControl)
private
  BackControl : TWinControl;
  ChangeStyleFlag : Boolean;
  FHeight : Integer;
  FStyle : TReferencePanelStyle;
  FWidth : Integer;

  procedure SetHeight(Value : Integer);
  procedure SetStyle(Value : TReferencePanelStyle);
  procedure SetWidth(Value : Integer);
  procedure WMSize( var Message: TWMSize );  message WM_SIZE;
protected
  procedure Loaded; override;
  procedure  Paint; override;
public
  constructor  Create(AOwner : TComponent); override;
  procedure CreateParams( var Params: TCreateParams ); override;
  destructor Destroy; override;
  procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
  procedure WriteState(Writer: TWriter);  override;
published
  property Style : TReferencePanelStyle read FStyle write SetStyle;
  property Height : Integer read FHeight write SetHeight;
  property Width : Integer read FWidth write SetWidth;
  property TabOrder;
  property OnKeyDown;
end;

TReferenceFilter = class(TReference)
private
  FAutoFilter : TAutoFilter;
  FErrorValue : String;
  FNullValue : String;

  function GetOnBeforeFilterChange : TNotifyEvent;
  function GetOnAfterFilterChange : TNotifyEvent;
  procedure SetErrorValue(Value : String);
  procedure SetNullValue(Value : String);
  procedure SetOnBeforeFilterChange(Value : TNotifyEvent);
  procedure SetOnAfterFilterChange(Value : TNotifyEvent);
protected
  procedure DoOnChange(FState : TReferenceState); override;
public
  constructor Create(AOwner : TComponent); override;
  destructor Destroy; override;
published
  property AssignField;
  property AutoFilter : TAutoFilter read FAutoFilter write FAutoFilter;
  property ErrorValue : String read FErrorValue write SetErrorValue;
  property NullValue : String read FNullValue write SetNullValue;
  property OnBeforeFilterChange: TNotifyEvent read GetOnBeforeFilterChange write SetOnBeforeFilterChange;
  property OnAfterFilterChange: TNotifyEvent read GetOnAfterFilterChange write SetOnAfterFilterChange;
end;

TPopupReferenceForm = class(TForm)
  BottomPanel: TPanel;
  BOk: TButton;
  BCancel: TButton;
  Panel: TPanel;
  DBGrid: TAutoDBGrid;
private
  {$IFDEF DELPHI3_0}
  ParentForm : TCustomForm;
  {$ELSE}
  ParentForm : TForm;
  {$ENDIF}
  procedure BottomPanelResize(Sender : TObject);
  procedure FormKeyDown(Sender : TObject; var Key: Word; Shift: TShiftState);
  procedure WMNCActivate(var Message : TMessage); message WM_NCACTIVATE;
public
  constructor Create(AOwner : TComponent); override;
end;


function PopupReference(AGridLayout : TAutoGridLayout; APanel : TReferencePanel;
            ARefAlign : TReferenceAlign; ARepository : TAutoRepository;
            Var AWidth, AHeight : Integer) : Boolean;

implementation

uses aclconst;
{$R *.DFM}
{$R refer.res}

constructor TPopupReferenceForm.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);
  OnKeyDown := FormKeyDown;
  BottomPanel.OnResize := BottomPanelResize;
  ParentForm := Nil;
end;

procedure TPopupReferenceForm.BottomPanelResize(Sender : TObject);
begin
  BCancel.Left := BottomPanel.Width - BCancel.Width - 5;
  BOk.Left := BCancel.Left - BOk.Width - 10;
end;

procedure TPopupReferenceForm.FormKeyDown(Sender : TObject; var Key: Word; Shift: TShiftState);
begin
  if(Key = VK_ESCAPE)  then
    ModalResult := mrCancel;
end;

procedure TPopupReferenceForm.WMNCActivate(var Message : TMessage);
begin
  if(ParentForm <> Nil) then
    SendMessage(ParentForm.Handle, WM_NCACTIVATE,LongInt(True),0);
  Message.wParam := LongInt(True);
  Message.Result := DefWindowProc(Handle, Message.Msg, Message.wParam, Message.lParam);
end;


function PopupReference(AGridLayout : TAutoGridLayout; APanel : TReferencePanel;
            ARefAlign : TReferenceAlign; ARepository : TAutoRepository;
            Var AWidth, AHeight : Integer) : Boolean;
Var
  ptUpper, ptLower: TPoint;
  rectPlace : TRect;
  FReferencePanelAlign : TAlign;
  FReferencePanelParent : TWinControl;
  FReferencePanelWidth, FReferencePanelHeight : Integer;
  FReferencePanelTop, FReferencePanelLeft : Integer;
  FReferencePanelStyle : TReferencePanelStyle;
  FReferencePanelTabOrder : TTabOrder;
  FReferencePanelVisible : Boolean;

  PopUpForm : TPopupReferenceForm;
  AControlOwner : TWinControl;  
begin
  PopUpForm := TPopupReferenceForm.Create(Nil);
  if(AGridLayout.Owner is TWinControl) then 
    AControlOwner := TWinControl(AGridLayout.Owner)
  else AControlOwner := Nil;
  if(AControlOwner <> Nil) then
    PopUpForm.ParentForm :=  GetParentForm(AControlOwner);
  with PopUpForm do begin
    if(csDesigning in AGridLayout.Owner.ComponentState) then begin
      BorderStyle := bsSizeable;
      Caption := AGridLayout.Owner.Name;
      KeyPreview := True;
    end else BorderStyle := bsNone;
    BorderIcons := [];
    Width := AWidth;
    Height := AHeight;
  end;

  if(AControlOwner <> Nil) then begin
    rectPlace := AControlOwner.ClientRect;
    ptUpper.X := rectPlace.Left;
    ptUpper.Y := rectPlace.Top;
    ptUpper := AControlOwner.ClientToScreen( ptUpper );
    ptLower.X := rectPlace.Right;
    ptLower.Y := rectPlace.Bottom;
    ptLower := AControlOwner.ClientToScreen( ptLower );

    if ptUpper.X + 1 + PopUpForm.Width > Screen.Width then
      PopUpForm.Left := Screen.Width - PopUpForm.Width - 2
    else PopUpForm.Left := ptUpper.X - 2;
    if(PopUpForm.Left < 0) then PopUpForm.Left := 0;
    if ptLower.Y + 1 + PopUpForm.Height > Screen.Height then
       PopUpForm.Top := ptUpper.Y - PopUpForm.Height
    else PopUpForm.Top := ptLower.Y + 1;
  end else begin
    PopupForm.Left := (Screen.Width - PopUpForm.Width) div 2;
    PopupForm.Left := (Screen.Height - PopUpForm.Height) div 2;
  end;

  if(APanel <> Nil) then begin
    with APanel do begin
      FReferencePanelAlign := Align;
      FReferencePanelParent := Parent;
      FReferencePanelWidth := Width;
      FReferencePanelHeight := Height;
      FReferencePanelTop := Top;
      FReferencePanelLeft := Left;
      FReferencePanelStyle := Style;
      FReferencePanelVisible := Visible;
      FReferencePanelTabOrder := TabOrder;
      OnKeyDown := PopupForm.FormKeyDown;
      Parent := PopUpForm;
      Style := bpStandart;
      Visible := True;
      TabOrder := 1;
      Align := TAlign(Integer(ARefAlign) + 1);
    end;
  end else
    with APanel do begin
      FReferencePanelAlign := alNone;
      FReferencePanelParent := Nil;
      FReferencePanelWidth := 0;
      FReferencePanelHeight := 0;
      FReferencePanelTop := 0;
      FReferencePanelLeft := 0;
      FReferencePanelStyle := bpStandart;
      FReferencePanelVisible := False;
      FReferencePanelTabOrder := 0;
    end;

  with PopupForm.DBGrid do begin
    Repository := ARepository;
    GridLayout.Assign(AGridLayout);
  end;

  PopUpForm.ShowModal;
  if(PopUpForm.ModalResult = mrOk) then
    Result := True
  else Result := False;

  AWidth := PopUpForm.Width;
  AHeight := PopUpForm.Height;

  if(APanel <> Nil) then
    with APanel do begin
      OnKeyDown := Nil;
      Width := FReferencePanelWidth;
      Height := FReferencePanelHeight;
      Align := FReferencePanelAlign;
      Top := FReferencePanelTop;
      Left := FReferencePanelLeft;
      Style := FReferencePanelStyle;
      Visible := FReferencePanelVisible;
      TabOrder := FReferencePanelTabOrder;
      Parent := FReferencePanelParent;
    end;

  PopUpForm.Free;
end;


{TRefMaskEdit}
constructor  TRefMaskEdit.Create(AOwner : TComponent);
begin
  inherited;
  BitBtn := TBitBtn.Create(self);
  BitBtn.Parent := self;
  BitBtn.Top := 0;
  OnExit := DoOnChange;
  BitBtn.OnEnter := DoOnChange;
  BitBtn.OnExit := OnExit;
end;

destructor TRefMaskEdit.Destroy;
begin
  BitBtn.Free;
  inherited;
end;

procedure TRefMaskEdit.CreateParams( var Params: TCreateParams );
begin
  inherited CreateParams(Params);
  Params.Style := Params.Style or WS_CLIPCHILDREN or ES_MULTILINE;
end;

procedure TRefMaskEdit.CreateWnd;
begin
  inherited CreateWnd;
  SetEditRect;
end;

procedure TRefMaskEdit.SetEditRect;
Var
  R : TRect;
begin
  R := ClientRect;
  R.Right := BitBtn.Left - 1;
  SendMessage(Handle, EM_SETRECTNP, 0, LongInt(@R));
  SendMessage(Handle, EM_SCROLLCARET, 0, 0);
end;


procedure TRefMaskEdit.WMSize(var Message: TWMSize);
begin
  with BitBtn do begin
    Height := self.Height - 3;