wwdblook.pas

胜天进销存源码,国产优秀的进销存

    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;

    function CanEdit: Boolean; virtual;
    procedure InitFields(showError: boolean);
    procedure CreateWnd; override;
    procedure KeyPress(var Key: Char); override;
    procedure LinkActive(Value: Boolean); override;
    procedure Scroll(Distance: Integer); override;
    procedure ListClick; dynamic;
    procedure Loaded; override;
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;
    procedure Paint; override;
    procedure DataChanged; override;

    procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL;
    procedure DrawCell(ACol, ARow: Longint; ARect: TRect;  AState: TGridDrawState); override;

  public
    lookupFieldCount: integer;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    property Value: string read GetValue write SetValue;
    property DisplayValue: string read GetDisplayValue write SetDisplayValue;
    property DisplayFld: TField read FDisplayFld;
    property VisibleRowCount;

    procedure SetColumnAttributes; override;
    procedure DoLookup(SetToDisplayIndex: boolean);

  published
    {$ifdef wwDelphi4Up}
    property Anchors;
    property Constraints;
    {$endif}
    property Selected : TStrings read getSelectedFields write setSelectedFields;
    property LookupTable : TDataSet read GetLookupTable write setLookupTable;

    property DataField: string read GetDataField write SetDataField;
    property DataSource: TDataSource read GetDataSource write SetDataSource;
    property LookupField: string read GetLookupField write SetLookupField;
    property Options: TwwDBLookupListOptions read FOptions write SetOptions default [];
    property OnClick: TNotifyEvent read FOnListClick write FOnListClick;
    property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
    property Align;
    property BorderStyle;
    property Color;
    property Ctl3D;
    property DragCursor;
    property DragMode;
    property Enabled;
    property Font;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Visible;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
  end;


  TwwPopupGrid = class(TwwDBLookupList)
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWnd; override;
    procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    function CanEdit: Boolean; override;
    procedure LinkActive(Value: Boolean); override;

  public
    property RowCount;
    property ColCount;
    constructor Create(AOwner: TComponent); override;
  published
    property ControlType; { 1/10/2000 }
  end;


  TwwLookupComboButton = class(TwwComboButton)
  protected
    function IsVistaTransparentButton: boolean; override;
    function IsVistaComboNonEditable: boolean; override;
    function ParentMouseInControl: boolean; override;
    function ParentDroppedDown: boolean; override;

    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure Paint; override;
  end;

procedure Register;

implementation

uses DBConsts,
{$ifdef wwDelphi3Up}
 BDEConst,
{$endif}
{$ifdef wwDelphi6Up}
variants,
{$endif}
{$ifdef wwDelphi7Up}
themes,
{$endif}
wwdbgrid, wwquery;

{$IFDEF WIN32}
{$R WWDBD32.RES}
{$ELSE}
{$R WWDBDLG.RES}
{$ENDIF}


type
  TCheatGridCast = class(TCustomGrid);
  TwwCheatGridCast = class(TwwDBGrid);

{$ifdef wwDelphi3Up}
procedure RaiseException(error: string);
{$else}
procedure RaiseException(error: word);
{$endif}
begin
  {$ifdef wwDelphi3Up}
   raise EInvalidOperation.Create (error);
  {$else}
   raise EInvalidOperation.Create (LoadStr (error));
  {$endif}
end;

constructor TwwDropDownGridOptions.Create(AOwner: TComponent);
begin
   FColor:= clWindow;
   FTitleLines:= 1;
   FTitleAlignment:= taLeftJustify;
end;

{ TwwDBCustomLookupCombo}

{ The following hook proc is a workaround for a delphi 4 bug
  where it no longer sends a CM_CANCELMODE message when the end-user
  clicks away from the dropped down list }
{$ifdef wwDelphi4up}
var wwLookupComboHook: HHOOK;

function wwLookupComboHookProc(nCode: Integer; wParam: Integer; lParam: Integer): LResult; stdcall;
var r1, r2: TRect;
begin
  result := CallNextHookEx(wwLookupComboHook, nCode, wParam, lParam);
  with PMouseHookStruct(lParam)^ do
  begin
    if (wParam = WM_LBUTTONDOWN) or (wParam = WM_NCLBUTTONDOWN) then
    begin
      if (Screen.ActiveControl <> nil) and (Screen.ActiveControl is TwwDBCustomLookupCombo) then
        with (Screen.ActiveControl as TwwDBCustomLookupCombo) do
      begin
        { Auto-closeup if clicked outside of drop-down area }
        if FGrid.visible then begin
           GetWindowRect(FGrid.Handle, r1);
           GetWindowRect(Handle, r2);
           if (not PtInRect(r1, pt)) and (not PtInRect(r2, pt)) then
             { 11/15/98 - Calling closeup immediately would cause problems
              if user's OnCloseUp aborted }
             PostMessage(Handle, CM_CANCELMODE, 0, 0);
//           CloseUp(True);
        end
      end;
    end;
  end;
end;
{$endif}

type
  TwwComboButtonEffects = class(TwwButtonEffects)
     protected
        procedure Refresh; override;
  end;

 TBtnWinControl = class(TWinControl)
 private
    EditControl: TwwDBCustomLookupCombo;
    procedure WMEraseBkgnd(var Message: TWmEraseBkgnd); message WM_ERASEBkgnd;
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
  public
    constructor Create(AOwner: TComponent); override;
 end;

Procedure TwwComboButtonEffects.refresh;
begin
   (Control as TwwDBCustomLookupCombo).Updatebuttonglyph;
//   (Button as TSpeedButton).Glyph.Handle:=
//     TwwDBCustomLookupCombo(Control).LoadComboGlyph;
end;

procedure TBtnWinControl.WMEraseBkgnd(var Message: TWmEraseBkgnd);
var r: TRect;
    cc: TwwDBCustomLookupCombo;
begin

  if EditControl.IsVistaComboNonEditable then
  begin
     message.result:=1;
     exit;
  end;

  cc:= TwwDBCustomLookupCombo(parent);
  if cc.skipupdate then exit;

  if (IsInGridPaint(parent) or
     cc.isTransparentEffective)  then
  begin
     { Fixes paint problem when mouse is clicked in button and moved outside
       region, but it is not released }
     if (not IsInGridPaint(parent)) and
        (cc.ButtonEffects.Flat or cc.ButtonEffects.Transparent) and
        (csLButtonDown in cc.FButton.ControlState) then
     begin
        r:= Rect(parent.left + Left , parent.Top+top,
                 parent.left + left + Width, parent.top + Top + Height);
        InvalidateRect(parent.parent.handle, @r, False);
        cc.skipupdate:= true;
        parent.parent.update;
        cc.skipupdate:= False;
     end;
     message.result:= 1;
  end
  else inherited;
end;

constructor TBtnWinControl.Create(AOwner: TComponent);
begin
   inherited Create(AOwner);
   EditControl:= AOwner as TwwDBCustomLookupCombo;
end;

procedure TBtnWinControl.CMMouseEnter(var Message: TMessage);
begin
  inherited;
{  if EditControl.FButton.Flat then
  begin
     EditControl.UpdateButtonPosition;
     Invalidate;
  end}
end;

procedure TBtnWinControl.CMMouseLeave(var Message: TMessage);
var r: TRect;
    offset: integer;
begin
  inherited;

  if not EditControl.ButtonEffects.Flat then exit;

  if EditControl.BorderStyle=bsSingle then offset:=2 else offset:= 0;
  if not EditControl.FFocused then begin
     if EditControl.IsTransparentEffective then begin
        r:= Rect(parent.left + Left + offset, parent.Top+top+offset,
                 parent.left + left + offset + Width, parent.top + offset + Top + Height);
        if wwIsTransparentParent(self) then
          wwInvalidateTransparentArea(self, false) // just to be safer, but probably works in both cases
        else
          InvalidateRect(parent.parent.handle, @r, True);
        Invalidate;
     end;
     Invalidate;
  end
end;



constructor TwwDBCustomLookupCombo.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  FDropDownGridOptions := TwwDropDownGridOptions.Create(Self);
  FPicture:= TwwDBPicture.create(nil);

  FButtonStyle:= cbsDownArrow;
  FLastSearchKey:= '';
{  AutoSize := False; } { Removed 5/2/97 }

{$IFDEF WIN32}
  ControlStyle := ControlStyle + [csReplicatable];
  ExtraHeight:= 0;
{$ELSE}
  ExtraHeight:= 1;
{$ENDIF}

  FFieldLink := TFieldDataLink.Create;
  FFieldLink.Control := Self; {Release adds this }
  FFieldLink.OnDataChange := DataChange;
  FFieldLink.OnEditingChange := EditingChange;
  FFieldLink.OnUpdateData := UpdateData;
  FFieldLink.OnActiveChange := FieldLinkActive;

  FBtnControl := TBtnWinControl.Create (Self);
  {$IFDEF WIN32}
  FBtnControl.ControlStyle := FBtnControl.ControlStyle + [csReplicatable];
  {$ENDIF}
  FBtnControl.Width:= wwmax(GetSystemMetrics(SM_CXVSCROLL)+4, 17); {4/14/97}
  FBtnControl.Height := 17;
  FBtnControl.Visible := True;;
  FBtnControl.Parent := Self;

  FButton := TwwLookupComboButton.Create (Self);
  {$IFDEF WIN32}
  FButton.ControlStyle := FButton.ControlStyle + [csReplicatable];
  {$ENDIF}
  FButton.SetBounds (0, 0, FBtnControl.Width, FBtnControl.Height);
  FButton.Width:= wwmax(GetSystemMetrics(SM_CXVSCROLL), 15); {5/2/97 }
  FButton.Visible := True;
  FButton.Parent := FBtnControl;

  FGrid := TwwPopupGrid.Create(Self);
  FGrid.height:= 0; { 10/16/98 -Faster performance }