wwdotdot.pas

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

{
//
// Components : TwwDBCustomCombo, TwwDBComboDlg
//
// Copyright (c) 1996-2001 by Woll2Woll Software
//
//
// 2/25/98 - Call IsValidChar instead of checking [32..255] in KeyDown method
//
// 9/2/98 -  Call FButton.Update in paint event so Delphi 4 paints icon correctly
//           in DBCtrlGrid
// 11/10/98 - Publish ParentBidiMode
// 1/11/2000- Publish WordWrap
// 3/13/00 - MDI forms should check ActiveControl instead of focused
//          when button is clicked.  This fixes problem where
//          button click not recognized when switching back to mdi child
}
unit Wwdotdot;

interface
{$i wwIfDef.pas}

uses
  Forms, SysUtils, Windows, Messages, Classes,
  Controls, Buttons, Graphics,
  dbctrls, mask, db, dbtables, stdctrls, wwdbedit, wwdblook, wwdatsrc,
  wwframe, wwcombobutton;

type

//  TwwComboButton = class
  TwwDBCustomCombo =class(TwwDBCustomEdit)
   private
    FBtnControl:TWincontrol;
    FButton:TwwComboButton;
    FOnCustomDlg:TNotifyevent;
    FStyle: TwwDBLookupComboStyle;
    FButtonStyle: TwwComboButtonStyle;
    FDroppedDown: boolean;
    FMouseInButtonControl: boolean;
    FLimitEditRect: boolean;
    FButtonEffects: TwwButtonEffects;
//    FButtonGlyph: TBitmap;
    FButtonWidth: integer;
    SkipUpdate: boolean;
    FAutoEnableEdit: boolean;

    procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
    procedure CMExit(var Message: TCMExit); message CM_EXIT;
    procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
    procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
    procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP;
    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
    procedure WMPaint(var Message: TMessage); message WM_PAINT;
    procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
    procedure SetButtonGlyph(Value: TBitmap);
    Function GetButtonGlyph: TBitmap;
    procedure NonEditMouseDown(var Message: TWMLButtonDown);
    procedure SetButtonStyle(val: TwwComboButtonStyle);
    Procedure UpdateButtonPosition;
    Procedure SetButtonWidth(val: integer);
    function GetButtonWidth: integer;

   protected
//    procedure GlyphChanged(Sender: TObject); virtual;
    function IsCustom: Boolean; virtual;
    procedure KeyPress(var Key: Char); override;
    procedure CreateParams(var Params: TCreateParams); override;
    Procedure UpdateButtonGlyph;
//    Function LoadComboGlyph: HBitmap; virtual;
    Procedure DrawButton(Canvas: TCanvas; R: TRect; State: TButtonState;
       ControlState: TControlState; var DefaultPaint: boolean); virtual;
    procedure SetEditRect; override;
    procedure WMSize(var msg:twmsize); message wm_size;
    procedure BtnClick(sender:tobject);
    procedure BtnMouseDown(Sender: TObject; Button: TMouseButton;
     Shift: TShiftState; X, Y: Integer);
    function GetShowButton: boolean; override;
    procedure SetShowButton(sel: boolean); override;
    Function GetIconIndent: integer; override;
    Function GetIconLeft: integer; override;
    Function Editable: boolean; override;
//    Function GetClientEditRect: TRect; override;
    Function IsDroppedDown: boolean; override;
    procedure CloseUp(Accept: Boolean); virtual;
    procedure HandleDropDownKeys(var Key: Word; Shift: TShiftState);
    procedure Loaded; override;
    procedure InvalidateTransparentButton;
    Function MouseEditable: boolean; virtual;
    property BtnControl : TWinControl read FBtnControl;

   public
    constructor Create(AOwner:tcomponent); override;
    destructor Destroy; override;
    procedure DropDown; virtual;

    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    property AutoEnableEdit: boolean read FAutoEnableEdit write FAutoEnableEdit default True;
    property Button: TwwComboButton read FButton;
    property OnCustomDlg: TNotifyevent read FOnCustomDlg write FOnCustomDlg;
    property Style: TwwDBLookupComboStyle read FStyle write FStyle;
    property ButtonStyle: TwwComboButtonStyle read FButtonStyle write SetButtonStyle;
    property ButtonEffects: TwwButtonEffects read FButtonEffects write FButtonEffects;
//    property ButtonFlat : boolean read GetFlatButton write SetFlatButton default False;
//    property ButtonTransparent: boolean read FFlatButtonTransparent write SetFlatButtonTransparent default false;
    property LimitEditRect: boolean read FLimitEditRect write FLimitEditRect default False;
    property ButtonGlyph: TBitmap read GetButtonGlyph write SetButtonGlyph stored IsCustom;
    property ButtonWidth: integer read GetButtonWidth write SetButtonWidth default 0;
     { LimitEditRect allows text to scroll instead of being typed over button area.
       Set this to true to force the caret to always be visible instead of being hidden behind the button.
       The negative consequence of this being set to true is that the combobox will no
       longer close the form on an escape, as the escape goes to the control instead }

  end;

  TwwDBComboDlg =class(TwwDBCustomCombo)
   published
    property BevelEdges;
    property BevelInner;
    property BevelKind default bkNone;
    property BevelOuter;

    property Controller;
    property DisableThemes;
    property OnCustomDlg;
    {$ifdef wwDelphi4Up}
    property Anchors;
    property BiDiMode;
    property Constraints;
    property ParentBiDiMode; { 11/10/98 }
    {$endif}
    property AutoEnableEdit;
    property ShowButton;
    property Style;
    property ButtonStyle default cbsEllipsis;
    property AutoFillDate;
    property AutoSelect;
    property AutoSize;
    property BorderStyle;
    property CharCase;
    property Color;
    property Ctl3D;
    property DataField;
    property DataSource;
    property DragCursor;
    property DragMode;
    property Enabled;
    property ButtonEffects;
//    property ButtonTransparent;
//    property ButtonFlat;
    property Frame;
    property ButtonWidth;
    property ButtonGlyph;
    property Font;
    property EditAlignment;
    {$ifdef wwDelphi3Up}
    property ImeMode;
    property ImeName;
    {$endif}
    property LimitEditRect;
    property MaxLength;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PasswordChar;
    property Picture;
    property PopupMenu;
    property ReadOnly;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property WordWrap; { 1/11/0000 }
//    property Transparent;
    property UnboundDataType;
    property UsePictureMask;
    property Visible;
    property UnboundAlignment;

    property OnChange;
    property OnCheckValue;
    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;

  end;

  TwwComboDlgButton = class(TwwComboButton)
  protected
    procedure Paint; override;
    function IsVistaTransparentButton: boolean; override;    
    function IsVistaComboNonEditable: boolean; override;
    function ParentMouseInControl: boolean; override;
    function ParentDroppedDown: boolean; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
  end;

  procedure Register;

implementation

uses
  {$ifdef wwDelphi7Up}
  Themes, UxTheme,
  {$endif}
  wwcommon;


{.$R *.RES}

type
{  TwwButton = clas(TSpeedButton)
    protected
  end;
}
  TwwComboButtonEffects = class(TwwButtonEffects)
     protected
        procedure Refresh; override;
  end;

  TBtnWinControl = class(TWinControl)
  private
    EditControl: TwwDBCustomCombo;

    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 TwwDBCustomCombo).Updatebuttonglyph;
//   (Button as TSpeedButton).Glyph.Handle:= TwwDBCustomCombo(Control).LoadComboGlyph;
end;


procedure TBtnWinControl.WMEraseBkgnd(var Message: TWmEraseBkgnd);
var r: TRect;
    cc: TwwDBCustomCombo;
begin
  if EditControl.IsVistaComboNonEditable then
  begin
     message.result:=1;
     exit;
  end;
  cc:= TwwDBCustomCombo(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 TwwDBCustomCombo.Create;
begin
   inherited create(aowner);

   FButtonStyle:= cbsEllipsis;
   FAutoEnableEdit:= True;

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

   FButton:=TwwComboDlgButton.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.Parent:= FBtnControl;
   FButton.OnClick:=BtnClick;
   FButton.OnMouseDown:= BtnMouseDown;
   FButton.OnMouseUp:= BtnMouseDown;
   FLimitEditRect:= False;

//   FButtonGlyph := TBitmap.Create;
//   FButtonGlyph.OnChange := GlyphChanged;

   FButtonEffects:= TwwComboButtonEffects.create(self, FButton);
//   FButton.Glyph.Handle:= LoadComboGlyph;


end;

destructor TwwDBCustomCombo.Destroy;
begin
  FButtonEffects.Free;
  FButton.Free;
  FButton:= Nil;
//  FButtonGlyph.Free;
  inherited Destroy;
end;

procedure TwwDBCustomCombo.WMPaint(var Message: TMessage);
begin
  inherited;
  if IsInWWObjectView(self) then
  begin
    FButton.Invalidate;
//    if ShowButton then
//       TwwComboDlgButton(FButton).Paint;
  end
  else begin
    FButton.Invalidate;
    FButton.Update; { 9/2/98 }
  end
end;

Function TwwDBCustomCombo.GetIconIndent: integer;
begin
   result:= FBtnControl.Width;
end;

Function TwwDBCustomCombo.GetIconLeft: integer;
begin
   result:= FBtnControl.Left - 1;
end;

Procedure TwwDBCustomCombo.UpdatebuttonGlyph;
begin
//   FButton.Glyph.Handle:=0;  7/28/01 - Don't clear glyph

   if (FButtonStyle<>cbsCustom) and
      (ButtonEffects.Flat or ButtonEffects.Transparent) then
   begin
      if (FButtonStyle = cbsDownArrow) then
         FButton.Glyph.Handle:= LoadBitmap(HInstance, 'WWDROPDOWN')
   end;
end;

(*
Function TwwDBCustomCombo.LoadComboGlyph: HBitmap;
begin
   result:= 0;
   if (FButtonStyle=cbsCustom) and (FButtonGlyph<>nil) then
   begin
      result:= FButtonGlyph.Handle;
   end
   else if ButtonEffects.Flat or ButtonEffects.Transparent then
   begin
      if (FButtonStyle = cbsDownArrow) {and (FlatButtonTransparent) }then
         result:= LoadBitmap(HInstance, 'WWDROPDOWN')
//      else
//        result:= LoadBitmap(HInstance, 'WWDOTS')
   end;
end;
*)
function TwwDBCustomCombo.GetShowButton: boolean;
begin
   result:= FBtnControl.visible;
end;

procedure TwwDBCustomCombo.SetShowButton(sel: boolean);
begin
   if (FBtnControl.visible<> sel) then
   begin
      FBtnControl.visible:= sel;
      {10/5/97 - Don't call SetEditRect when loading as this is called when
                 loading is completed.  SetEditRect should be called after
                 all the properties are read in. }
      if (Owner=nil) or // 5/30/01
         not (csLoading in Owner.ComponentState) then SetEditRect;
      self.invalidate;
   end
end;

procedure TwwDBCustomCombo.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  Params.Style :=(Params.Style and not (ES_AUTOVSCROLL or ES_WANTRETURN) or
                   WS_CLIPCHILDREN);
  {$ifdef wwdelphi4up}
  if UseRightToLeftAlignment or LimitEditRect then
    Params.Style:= Params.Style or ES_MULTILINE;
  {$endif}

end;

procedure TwwDBCustomCombo.SetEditRect;
var
  Loc: TRect;
begin
  Loc.Bottom :=ClientHeight+1; {+1 is workaround for windows paint bug}
  if ShowButton then Loc.Right := FBtnControl.Left - 2
  else Loc.Right:= ClientWidth - 2;

  if (Frame.IsFrameEffective) then
  begin
     Frame.GetEditRectForFrame(Loc);
  end
  else if (BorderStyle = bsNone) and
     (IsInwwObjectView(self)) then begin
     Loc.Top := 1;
     Loc.Left := 1;
  end
  else if (BorderStyle = bsNone) then begin
     Loc.Top := 2;
     Loc.Left := 2;
  end
  else begin
     Loc.Top := 0;
     Loc.Left := 0;
  end;

  SendMessage(Handle, EM_SETRECTNP, 0, LongInt(@Loc));
end;

type
 TCheatButton = class(TwwComboButton);

Procedure TwwDBCustomCombo.UpdateButtonPosition;
var offset :Integer;
begin
  {$ifdef WIN32}
  if Frame.IsFrameEffective then
  begin
     offset:= 2;
  end
  else offset:= 0;
  if (not NewStyleControls) or (BorderStyle = bsNone) or (not Ctl3d) then
     FBtnControl.SetBounds (Width - FButton.Width - offset, offset, FButton.Width, ClientHeight-offset*2)
  else
     FBtnControl.SetBounds (Width - FButton.Width - 4, offset, FButton.Width, ClientHeight-offset);

  if BorderStyle = bsNone then begin
     FButton.Top:= -1; {Allows bitmap to be larger }
     FButton.Height := FBtnControl.Height+1;
  end
  else begin
     FButton.Top:= 0; {Allows bitmap to be larger }
     FButton.Height := FBtnControl.Height;
  end;
  {$else}
  if (not NewStyleControls) or (BorderStyle = bsNone) then
     FBtnControl.SetBounds (Width - FButton.Width, 0, FButton.Width, ClientHeight)
  else
     FBtnControl.SetBounds (Width - FButton.Width - 2, 2, FButton.Width, ClientHeight-4);
  FButton.Height := FBtnControl.Height;
  {$endif}

  SetEditRect;
end;

procedure TwwDBCustomCombo.WMSize;
begin
  inherited;
  UpdateButtonPosition;
end;

procedure TwwDBCustomCombo.BtnMouseDown(Sender: TObject; Button: TMouseButton;
     Shift: TShiftState; X, Y: Integer);
begin
   exit; { Check if following code needed by exiting out and testing }
{   if FFlatButton and FFlatButtonTransparent then begin
     with FBtnControl do begin
         r:= Rect(parent.left + Left, parent.Top+top,
                 parent.left + left+ Width, parent.top + Top + Height);
         InvalidateRect(parent.parent.handle, @r, True);
         parent.parent.Update;
     end
   end;}
end;

procedure TwwDBCustomCombo.BtnClick;
var parentForm: TCustomForm;
begin
   if Patch[2]=False then exit;

   if isDroppedDown then CloseUp(True)
   else begin