fccombo.pas

一套及时通讯的原码

{
//
// Components : TfcCustomCombo
//
// Copyright (c) 2001 by Woll2Woll Software
//
// Changes:
// 3/23/99 - PYW - Need to automatically set datasource when dropping control
//                   in a TDBCtrlGrid.
// 3/25/99 -PYW - Make sure handle is allocated when setCaret is called.
// 6/6/99 - RSW - Close this modal form upon escape or return
// 6/22/99 - RSW - Use HWND_TOPMOST for drop-down control only for formstyle=fsStayOnTop
// 6/28/99 - Support unbound csPaintCopy
// 7/4/99 - Support TCustomGrid instead of just TwwDBGrid
// 9/15/99 - Make sure handle is for me in hook
// 1/28/2000 - Fix bitmap glyph paint problem when flat or transparent
// 8/16/2000 - Fire dropdown also if screen.activecontrol is me.  When TWebBrowser has
//             focus, the dropdown button was not working.
// 6/3/2001 - PYW - MDI Child forms would not get activated prior to setting focus by clicking on button.
// 10/1/2001 - Added for OnMouseEnter and OnMouseLeave events. -PYW
}
unit fcCombo;

interface
{$i fcIfDef.pas}
{$R-}
uses
  Forms, Menus, SysUtils, Windows, Graphics, Messages, Classes,
  Controls, Buttons, Mask, StdCtrls, fcCommon, TypInfo, Dialogs, Grids,
  DB, DBCtrls, fcframe, fccombobutton;

type
  TfcComboButtonStyle = (cbsEllipsis, cbsDownArrow, cbsCustom);
//  TfcComboButtonStyle = (cbsEllipsis, cbsDownArrow);
  TfcComboStyle = (csDropDown, csDropDownList);
  TfcAlignVertical = (fcavTop, fcavCenter);
  TfcComboCloseUpEvent = procedure(Sender: TObject; Select: boolean) of object;

  TfcDropDownButton = class(TfcComboButton)
  private
    procedure CMDesignHitTest(var Message: TCMDesignHitTest); message CM_DESIGNHITTEST;
  protected
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure Paint; override;
  end;

  TfcCustomCombo = class(TCustomEdit)
  private
    FController: TComponent;
    FAlignmentVertical: TfcAlignVertical;
    FBtnParent: TWinControl;
    FButton: TfcDropDownButton;
    FDataLink: TFieldDataLink;
    FDropDownCount: Integer;
    FInfoPower: Boolean;
    FOnCustomDlg: TNotifyevent;
    FOnCloseUp: TfcComboCloseUpEvent;
    FOnDropDown: TNotifyEvent;
    FOnAfterDropDown: TNotifyEvent;
    FButtonStyle: TfcComboButtonStyle;
//    FButtonGlyph: TBitmap;
    FButtonWidth: integer;
    FCanvas, FPaintCanvas: TControlCanvas;
    FStyle: TfcComboStyle;
    FReadOnly: boolean;
    FAllowClearKey: boolean;

    FOnMouseEnter: TNotifyEvent;
    FOnMouseLeave: TNotifyEvent;
    FFrame: TfcEditFrame;
    FButtonEffects: TfcButtonEffects;

    FSavedCursor: TCursor;
    FIgnoreCursorChange: Boolean;
    skipUpdate: boolean;
    FMouseInButtonControl: boolean;
    FDisableThemes: boolean;

    // Message Handlers
    procedure WMSetFont(var Message: TWMSetFont); message WM_SETFONT;
    procedure CMCancelMode(var Message: TCMCancelMode); message CM_CANCELMODE;
    procedure CMCursorChanged(var Message: TMessage); message CM_CURSORCHANGED;
    procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
    procedure CMExit(var Message: TCMExit); message CM_EXIT;
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
    procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
    procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
    procedure CNKeyDown(var Message: TWMKeyDown); message CN_KEYDOWN;
    procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
    procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    procedure WMCut(var Message: TMessage); message WM_CUT;
    procedure WMPaste(var Message: TMessage); message WM_PASTE;
    procedure WMEraseBkgnd(var Message: TWmEraseBkgnd); message WM_ERASEBkgnd;
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;

    // Property Access Methods
    procedure SetController(Value: TComponent);
    function GetDataField: string;
    function GetDataSource: TDataSource;
    function GetReadOnly: Boolean;
    procedure SetButtonStyle(Value: TfcComboButtonStyle);
    Function GetButtonGlyph: TBitmap;
    procedure SetButtonGlyph(Value: TBitmap);
    Procedure SetButtonWidth(val: integer);
    function GetButtonWidth: integer;
    procedure SetDataField(Value: string);
    procedure SetDataSource(Value: TDataSource);
    procedure SetReadOnly(Value: Boolean);
    procedure SetStyle(Value: TfcComboStyle);
    procedure SetAlignmentVertical(Value: TfcAlignVertical);
    procedure SetFocused(Value: Boolean);
  protected
    FFocused: Boolean;
//    Function LoadComboGlyph: HBitmap; virtual;
    Procedure UpdateButtonGlyph;
    procedure SetDropDownCount(Value: Integer); virtual;
    function GetDropDownControl: TWinControl; virtual; abstract;
    function GetDropDownContainer: TWinControl; virtual; abstract;
    function GetItemCount: Integer; virtual; abstract;
    function GetItemSize: TSize; virtual; abstract;
    function GetLeftIndent: Integer; virtual;
    procedure BtnMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); virtual;
    procedure DrawButton(Canvas: TCanvas; R: TRect; State: TButtonState;
    ControlState: TControlState; var DefaultPaint:boolean); virtual;
    procedure HideCaret; virtual;
    procedure Paint; virtual;
    procedure ShowCaret; virtual;
//    procedure GlyphChanged(Sender: TObject); virtual;

    // Virtual Property Access Methods
    function GetShowButton: Boolean; virtual;
    procedure SetModified(Value: Boolean); virtual;
    procedure SetShowButton(Value: Boolean);

    // Virtual Methods
    function Editable: Boolean; virtual;
    function EditCanModify: Boolean; virtual;
    function GetClientEditRect: TRect; virtual;
    function GetEditRect: TRect; virtual;
    function GetIconIndent: Integer; virtual;
    function GetIconLeft: Integer; virtual;
    procedure DoDropDown; virtual;
    procedure DoAfterDropDown; virtual;
    procedure CloseUp(Accept: Boolean); virtual;
    procedure DataChange(Sender: TObject); virtual;
    procedure EditingChange(Sender: TObject); virtual;
    procedure HandleDropDownKeys(var Key: Word; Shift: TShiftState); virtual;
    procedure HandleGridKeys(var Key: Word; Shift: TShiftState); virtual;
    procedure Reset; virtual;
    procedure SetEditRect; virtual;
    procedure UpdateButtonPosition; virtual;
    procedure UpdateData(Sender: TObject); virtual;
    function EffectiveReadOnly: Boolean; virtual;
    procedure DoCloseUp(Accept: boolean); virtual;
    procedure DoEnter; override;
    function SkipInheritedPaint : boolean; virtual;

    function GetRightIndent(Rect:TRect): Integer; virtual;
    function GetTopIndent: Integer; virtual;

    // Overridden Methods
    procedure Change; override;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWnd; override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyPress(var Key: Char); override;
    procedure Loaded; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure WndProc(var Message: TMessage); override;
    procedure PaintToCanvas(Canvas: TCanvas; Rect: TRect; Highlight, GridPaint: Boolean;
      Text: string); virtual; abstract;
    procedure DrawFrame(Canvas: TCanvas); virtual;
    function IsCustom: Boolean; virtual;
    procedure InvalidateTransparentButton;
    procedure DoMouseEnter; virtual;
    procedure DoMouseLeave; virtual;

    property Canvas: TControlCanvas read FCanvas;
    property DataLink: TFieldDataLink read FDataLink;
    property DropDownContainer: TWinControl read GetDropDownContainer;
    property BtnParent: TWinControl read FBtnParent;
  public
    ComboPatch: Variant;
    property Controller : TComponent read FController write SetController;

    constructor Create(AOwner:tcomponent); override;
    destructor Destroy; override;
    function isTransparentEffective: boolean;

    procedure SelectAll; virtual;
    function IsDataBound: Boolean; virtual;
    function IsDroppedDown: Boolean; virtual;
    procedure CheckCancelMode; virtual;
    procedure DrawInGridCell(ACanvas: TCanvas; Rect: TRect;
      State: TGridDrawState); virtual;
    procedure DropDown; virtual;

    property AlignmentVertical: TfcAlignVertical read FAlignmentVertical write SetAlignmentVertical default fcavTop;
    property AllowClearKey: boolean read FAllowClearKey write FAllowClearKey default False;
    property Button: TfcDropDownButton read FButton;
    property ButtonStyle: TfcComboButtonStyle read FButtonStyle write SetButtonStyle;
    property ButtonGlyph: TBitmap read GetButtonGlyph write SetButtonGlyph stored IsCustom;
    property ButtonWidth: integer read GetButtonWidth write SetButtonWidth default 0;
    property DataField: string read GetDataField write SetDataField;
    property DataSource: TDataSource read GetDataSource write SetDataSource;
    property DropDownCount: Integer read FDropDownCount write SetDropDownCount;
    property DropDownControl: TWinControl read GetDropDownControl;
    property InfoPower: Boolean read FInfoPower;
    property ItemCount: Integer read GetItemCount;
    property ItemSize: TSize read GetItemSize;
    property ReadOnly: Boolean read GetReadOnly write SetReadOnly;
    property ShowButton: boolean read GetShowButton write SetShowButton default True;
    property Style: TfcComboStyle read FStyle write SetStyle;
    property OnCustomDlg: TNotifyevent read FOnCustomDlg write FOnCustomDlg;
    property OnCloseUp: TfcComboCloseUpEvent read FOnCloseUp write FOnCloseUp;
    property OnDropDown: TNotifyEvent read FOnDropDown write FOnDropDown;
    property OnAfterDropDown: TNotifyEvent read FOnAfterDropDown write FOnAfterDropDown;

    property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
    property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;

    property Frame: TfcEditFrame read FFrame write FFrame;
    property ButtonEffects: TfcButtonEffects read FButtonEffects write FButtonEffects;
    property DisableThemes : boolean read FDisableThemes write FDisableThemes default False;
  end;

  function fcGetControlInGrid(Form: TComponent; Grid: TComponent; FieldName: string): TfcCustomCombo;

implementation

//uses uxtheme, tmschema;
  {$ifdef fcDelphi7Up}
  uses Themes;
  {$endif}
  {$ifdef ThemeManager}
  uses thememgr, themesrv, uxtheme;
  {$endif}

type
  TCheatGridCast = class(TCustomGrid);

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

var fcCOMBOHOOK: HHOOK = 0;
    WM_FC_CALLDROPDOWN: UINT = 0;

{$ifndef fcDelphi4Up}
function fcIsInwwObjectView(control: TWinControl):boolean;
begin
  result := False;
end;
function fcIsInwwObjectViewPaint(control: TWinControl):boolean;
begin
  result := False;
end;
{$endif}


function fcGetControlInGrid(Form: TComponent; Grid: TComponent; FieldName: string): TfcCustomCombo;
var i: Integer;
    ControlType: TStrings;
    AComponent: TComponent;
begin
  if not Boolean(fcGetOrdProp(Grid, 'ControlInfoInDataSet')) then
    ControlType := TStrings(fcGetOrdProp(Grid, 'ControlType'))
  else ControlType := TStrings(fcGetOrdProp(TDataSource(fcGetOrdProp(Grid, 'DataSource')).DataSet, 'ControlType'));

  result := nil;

  for i := 0 to ControlType.Count - 1 do
  begin
    if (fcGetToken(ControlType[i], ';', 0) = FieldName) then
    begin
      AComponent := Form.FindComponent(fcGetToken(ControlType[i], ';', 2));
      if AComponent is TfcCustomCombo then
         result := AComponent as TfcCustomCombo;
      Break;
    end;
  end;
end;

{ 9/28/99 - Change made 9/15/99 causes side effect of combo not clsing when dragging form's caption }
{ Logic changed }
function fcComboHookProc(nCode: Integer; wParam: Integer; lParam: Integer): LResult; stdcall;
var r1, r2: TRect;
    CurHandle: HWND;
    parentForm: TCustomForm;
begin
  result := CallNextHookEx(fcCOMBOHOOK, nCode, wParam, lParam);
  with PMouseHookStruct(lParam)^ do
  begin
    case wParam of
      WM_LBUTTONDOWN, WM_NCLBUTTONDOWN, WM_MOUSEMOVE, WM_LBUTTONUP:
      begin
        if (Screen.ActiveControl <> nil) and (Screen.ActiveControl is TfcCustomCombo) then
          with (Screen.ActiveControl as TfcCustomCombo) do
        begin
          // Auto-closeup if clicked outside of drop-down area
          // 9/15/99 - Make sure handle is for me }
          if IsDroppedDown {and (hwnd = DropDownControl.Handle) }then
          begin

            GetWindowRect(DropDownControl.Handle, r1);
            if (wParam = WM_LBUTTONDOWN) or (wParam = WM_NCLBUTTONDOWN) then
            begin
              GetWindowRect(Handle, r2);
//              if (not PtInRect(r1, pt)) and (not PtInRect(r2, pt)) then CloseUp(False);
              with r1 do
              begin
                Right := Left + DropDownControl.Width;
                Bottom := Top + DropDownControl.Height;
              end;
              CurHandle := Handle;
              if wParam = WM_LBUTTONDOWN then CurHandle := DropDownControl.Handle;

              parentForm:= GetParentForm(Screen.ActiveControl);
              if ((parentForm<>nil) and (parentForm.Handle=hwnd)) or
                 (GetParent(hwnd)<>0) then
              begin
                 if not PtInRect(r1, pt) then with DropDownControl.ScreenToClient(Point(pt.x, pt.y)) do
                   PostMessage(CurHandle, wParam, 0, MakeLParam(WORD(fcThisThat(x >= 0, x, -1)),WORD(fcThisThat(y >= 0, y, -1))));
              end
            end else if (hwnd = DropDownControl.handle) and
              ((wParam = WM_MOUSEMOVE) or (wParam = WM_LBUTTONUP)) then
            begin
               if not PtInRect(r1, pt) then with DropDownControl.ScreenToClient(Point(pt.x, pt.y)) do
                  PostMessage(DropDownControl.Handle, wParam, 0, MakeLParam(WORD(fcThisThat(x >= 0, x, -1)),WORD(fcThisThat(y >= 0, y, -1))));
            end
          end
        end;
      end;
    end;
  end;
end;

procedure TfcDropDownButton.CMDesignHitTest(var Message: TCMDesignHitTest);
begin
  inherited;
//  Message.Result := 1;
end;

procedure TfcDropDownButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
//  TfcCustomCombo(Owner).FDroppingDown := True;
  inherited;
end;

procedure TfcDropDownButton.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  inherited;
  TfcCustomCombo(parent.parent).InvalidateTransparentButton; { 1/28/2000 }
//  TfcCustomCombo(Owner).FDroppingDown := False;
end;

procedure TfcDropDownButton.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  inherited;
  if not PtInRect(Clientrect, Point(x, y)) then
  begin
    Perform(WM_LBUTTONUP, 0, MAKELPARAM(x, y));
    ReleaseCapture;
  end;
end;


procedure TfcDropDownButton.Paint;
var R : TRect;
    DefaultPaint:boolean;
begin
  if TfcCustomCombo(parent.parent).SkipUpdate then exit;

  if (csPaintCopy in ControlState) and
      not (csDesigning in ComponentState) and fcIsInGrid(parent.parent) then exit;

  SetRect(R, 0, 0, ClientWidth, ClientHeight);

   with TfcCustomCombo(Parent.Parent) do
   begin
      DefaultPaint:= True;
      FMouseInButtonControl:= MouseInControl;

      if (FButton.Glyph.Handle=0) or MouseInControl or
         FFocused or fcisClass(Parent.classType, 'TwwDBGrid') then
         if not (ButtonEffects.Transparent and (ButtonStyle=cbsDownArrow)) then
           if not fcUseThemes(self.parent.parent) then
           begin
              DrawButton(self.Canvas, R, FState, ControlState, DefaultPaint);
           end;
{           if not ThemeServices.ThemesEnabled then
           begin
              DrawButton(self.Canvas, R, FState, ControlState, DefaultPaint);
           end;
}
      if DefaultPaint then begin
         Ellipsis:= ButtonStyle = cbsEllipsis;
         inherited Paint;
      end;

      { Draw edges if Default Paint }
      if MouseInControl or (not ButtonEffects.Flat) or //FButton.Flat) or
         FFocused or fcisClass(Parent.classType, 'TwwDBGrid') then
      begin
         if not fcUseThemes(self.parent.parent) then
//         if not ThemeServices.ThemesEnabled then
         begin
            if FState=bsDown then
               DrawEdge(self.Canvas.Handle, R, EDGE_SUNKEN, BF_RECT)
            else
               DrawEdge(self.Canvas.Handle, R, EDGE_RAISED, BF_RECT)
         end;
      end
   end

end;

type
TfcComboButtonEffects = class(TfcButtonEffects)
   protected
      procedure Refresh; override;
end;

Procedure TfcComboButtonEffects.Refresh;
begin
   (Control as TfcCustomCombo).Updatebuttonglyph;
end;

constructor TfcCustomCombo.Create;
begin
  inherited Create(AOwner);

  ControlStyle := ControlStyle + [csReplicatable];

  FCanvas := TControlCanvas.Create;
  FCanvas.Control := self;

  FAlignmentVertical := fcavTop;
  FButtonStyle := cbsDownArrow;
  FDropDownCount := 8;

  FBtnParent := TBtnWinControl.Create (Self);
  with FBtnParent do
  begin
    ControlStyle := ControlStyle + [csReplicatable];
    Width := fcMax(GetSystemMetrics(SM_CXVSCROLL) + 4, 17);
    Height := 17;
    Visible := True;
    Parent := Self;
  end;