flatboxs.pas

相信大家已经找很长时间了

    procedure MouseDown (Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp (Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure WndProc (var Message: TMessage); override;

    procedure SetLBPosition(const Value: TLabelPosition);
    procedure SetLabelSpacing(const Value: Integer);
    procedure SetName(const Value: TComponentName); override;
    procedure CMVisiblechanged(var Message: TMessage); message CM_VISIBLECHANGED;
    procedure CMBidimodechanged(var Message: TMessage); message CM_BIDIMODECHANGED;
    procedure SetParent(AParent: TWinControl); override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure SetupInternalLabel;
   {$IFDEF DFS_COMPILER_4_UP}
    procedure SetBiDiMode(Value: TBiDiMode); override;
   {$ENDIF}
  public
    constructor Create (AOwner: TComponent); override;
    destructor Destroy; override;
    property Checked [Index: Integer]: Boolean read GetChecked write SetChecked;
    property SelCount: Integer read GetSelCount;
    procedure Clear;

    procedure Click; override;
    procedure CheckAll;
    procedure CheckCancel;
    function Find(Value:String; var Index : Integer):boolean;
    property ItemText:TCaption read GetItemText;

    property ItemIndex: Integer read GetItemIndex write SetItemIndex;
    procedure SetBounds(ALeft: Integer; ATop: Integer; AWidth: Integer; AHeight: Integer); override;
  published
    property CheckLabel: TBOXLabel read FCheckLabel;
    property LabelPosition: TLabelPosition read FLabelPosition write SetLBPosition default lpAbove;
    property LabelSpacing: Integer read FLabelSpacing write SetLabelSpacing default 3;

    property Items: TStringList read FItems write SetItems;
    property ItemHeight: Integer read FItemsHeight write SetItemsHeight default 17;
    property ScrollBars: Boolean read FScrollBars write SetScrollBars default false;
    property Color default $00E1EAEB;
    property ColorArrow: TColor index 0 read FArrowColor write SetColors default clBlack;
    property ColorBorder: TColor index 1 read FBorderColor write SetColors default $004080FF;
    property ColorItemsRect: TColor index 2 read FItemsRectColor write SetColors default clWhite;
    property ColorItemsSelect: TColor index 3 read FItemsSelectColor write SetColors default $009CDEF7;
    property ColorCheck: TColor index 4 read FCheckColor write SetColors default clBlack;
    property AdvColorBorder: TAdvColors index 0 read FAdvColorBorder write SetAdvColors default 40;
    property UseAdvColors: Boolean read FUseAdvColors write SetUseAdvColors default false;
    property Sorted: Boolean read FSorted write SetSorted default false;
    property TransparentMode: TTransparentMode read FTransparent write SetTransparent default tmNone;
    property Align;
    property Font;
    property ParentFont;
    property ParentColor;
    property ParentShowHint;
    property Enabled;
    property Visible;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property OnClick:TNotifyClick read FOnClick write FOnClick;
    property OnChange: TNotifyChange read FOnChange write FOnChange;
    property OnClickCheck: TNotifyEvent read FOnClickCheck write FOnClickCheck;
    property OnMouseMove;
    property OnMouseDown;
    property OnMouseUp;
   {$IFDEF DFS_COMPILER_4_UP}
    property Anchors;
    property BiDiMode write SetBidiMode;
    property Constraints;
    property DragKind;
    property ParentBiDiMode;
    property OnEndDock;
    property OnStartDock;
   {$ENDIF}
  end;
  { TFlatGroupBox }
  TFlatGroupBox = class(TCustomControl)
  private
    FTransparent: Boolean;
    FUseAdvColors: Boolean;
    FAdvColorBorder: TAdvColors;
    FBorderColor: TColor;
    FBorder: TGroupBoxBorder;
    procedure SetAdvColors (Index: Integer; Value: TAdvColors);
    procedure SetUseAdvColors (Value: Boolean);
    procedure CMEnabledChanged (var Message: TMessage); message CM_ENABLEDCHANGED;
    procedure CMTextChanged (var Message: TWmNoParams); message CM_TEXTCHANGED;
    procedure SetColors(const Index: Integer; const Value: TColor);
    procedure SetBorder(const Value: TGroupBoxBorder);
    procedure CMSysColorChange (var Message: TMessage); message CM_SYSCOLORCHANGE;
    procedure CMParentColorChanged (var Message: TWMNoParams); message CM_PARENTCOLORCHANGED;
    procedure CMDialogChar (var Message: TCMDialogChar); message CM_DIALOGCHAR;
    procedure WMSize (var Message: TWMSize); message WM_SIZE;
    procedure WMMove (var Message: TWMMove); message WM_MOVE;
    procedure SetTransparent (const Value: Boolean);
  protected
    procedure CalcAdvColors;
    procedure Paint; override;
   {$IFDEF DFS_COMPILER_4_UP}
    procedure SetBiDiMode(Value: TBiDiMode); override;
   {$ENDIF}
  public
    constructor Create (AOwner: TComponent); override;
  published
    property Transparent: Boolean read FTransparent write SetTransparent default false;
    property Align;
    property Cursor;
    property Caption;
    property Font;
    property ParentFont;
    property Color;
    property ParentColor;
    property PopupMenu;
    property ShowHint;
    property ParentShowHint;
    property Enabled;
    property Visible;
    property TabOrder;
    property TabStop;
    property Hint;
    property HelpContext;
    property ColorBorder: TColor index 0 read FBorderColor write SetColors default $004080FF;
    property Border: TGroupBoxBorder read FBorder write SetBorder default brFull;
    property AdvColorBorder: TAdvColors index 0 read FAdvColorBorder write SetAdvColors default 50;
    property UseAdvColors: Boolean read FUseAdvColors write SetUseAdvColors default false;
   {$IFDEF DFS_COMPILER_4_UP}
    property Anchors;
    property BiDiMode write SetBidiMode;
    property Constraints;
    property DragKind;
    property DragMode;
    property DragCursor;
    property ParentBiDiMode;
    property DockSite;
    property OnEndDock;
    property OnStartDock;
    property OnDockDrop;
    property OnDockOver;
    property OnGetSiteInfo;
    property OnUnDock;
   {$ENDIF}
   {$IFDEF DFS_DELPHI_5_UP}
    property OnContextPopup;
   {$ENDIF}
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDrag;
  end;

var
  MouseInControl: TFlatCheckBox = nil;

implementation

constructor TFlatComboBox.Create (AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle - [csFixedHeight] + [csOpaque];
  TControlCanvas(Canvas).Control := self;
  FButtonWidth    := 11;
  FSysBtnWidth    := GetSystemMetrics(SM_CXVSCROLL);
  FListInstance   := MakeObjectInstance(ListWndProc);
  FDefListProc    := nil;
  ItemHeight      := 13;
  FArrowColor     := clBlack;
  FArrowBackgroundColor := $00C5D6D9;
  FFocusedColor   := clWhite;
  FFlatColor      := $00E1EAEB;
  FParentColor    := True;
  FBorderColor    := $004080FF;
  FUseAdvColors   := False;
  FAdvColorBorder := 50;
  FAdvColorArrowBackground := 10;
  SetupInternalLabel;
  FLabelPosition  := lpLeft;
  FLabelSpacing   := 3;
end;

destructor TFlatComboBox.Destroy;
begin
  FreeObjectInstance(FListInstance);
  inherited;
end;

procedure TFlatComboBox.SetColors (Index: Integer; Value: TColor);
begin
  case Index of
    0: FArrowColor   := Value;
    1: FArrowBackgroundColor := Value;
    2: FBorderColor  := Value;
    3: FFlatColor    := Value;
    4: FFocusedColor := Value;
  end;
  if index = 3 then
     FParentColor := False;
  Invalidate;
end;

procedure TFlatComboBox.CalcAdvColors;
begin
  if FUseAdvColors then  begin
    FBorderColor := CalcAdvancedColor(TForm(Parent).Color, FBorderColor, FAdvColorBorder, darken);
    FArrowBackgroundColor := CalcAdvancedColor(TForm(Parent).Color, FArrowBackgroundColor, FAdvColorArrowBackground, darken);
  end;
end;

procedure TFlatComboBox.SetAdvColors (Index: Integer; Value: TAdvColors);
begin
  case Index of
    0: FAdvColorBorder := Value;
    1: FAdvColorArrowBackground := Value;
  end;
  CalcAdvColors;
  Invalidate;
end;

procedure TFlatComboBox.SetUseAdvColors (Value: Boolean);
begin
  if Value <> FUseAdvColors then
  begin
    FUseAdvColors := Value;
    CalcAdvColors;
    Invalidate;
  end;
end;

procedure TFlatComboBox.CMSysColorChange (var Message: TMessage);
begin
  if FUseAdvColors then
     CalcAdvColors
  else
    if FParentColor then begin
      if Parent <> nil then
         FFlatColor := TForm(Parent).Color;
    end;
  Invalidate;
end;

procedure TFlatComboBox.CMParentColorChanged (var Message: TWMNoParams);
begin
  if FUseAdvColors then
     CalcAdvColors
  else
    if FParentColor then begin
      if Parent <> nil then
         FFlatColor := TForm(Parent).Color;
    end;
  Invalidate;
end;

procedure TFlatComboBox.WndProc (var Message: TMessage);
begin
  if (Message.Msg = WM_PARENTNOTIFY) then
    case LoWord(Message.wParam) of
      WM_CREATE:
        if FDefListProc <> nil then
        begin
          SetWindowLong(FListHandle, GWL_WNDPROC, Longint(FDefListProc));
          FDefListProc := nil;
          FChildHandle := Message.lParam;
        end
        else
          if FChildHandle = 0 then
            FChildHandle := Message.lParam
          else
            FListHandle := Message.lParam;
      end
  else
    if (Message.Msg = WM_WINDOWPOSCHANGING) then
      if Style in [csDropDown, csSimple] then
        SetWindowPos( EditHandle, 0,
          0, 0, ClientWidth - FButtonWidth - 2 * 2 - 4, Height - 2 * 2 - 2,
          SWP_NOMOVE + SWP_NOZORDER + SWP_NOACTIVATE + SWP_NOREDRAW);
  inherited;
  if Message.Msg = WM_CTLCOLORLISTBOX then
  begin
    SetBkColor(Message.wParam, ColorToRGB(Color));
    Message.Result := CreateSolidBrush(ColorToRGB(Color));
  end;
end;

procedure TFlatComboBox.ListWndProc (var Message: TMessage);
begin
  case Message.Msg of
    WM_WINDOWPOSCHANGING:
      with TWMWindowPosMsg(Message).WindowPos^ do
      begin
        // size of the drop down list
        if Style in [csDropDown, csDropDownList] then
          cy := (GetFontHeight(Font)-2) * Min(DropDownCount, Items.Count) + 4
        else
          cy := (ItemHeight) * Min(DropDownCount, Items.Count) + 4;
        if cy <= 4  then
          cy := 10;
      end;
    else
      with Message do
        Result := CallWindowProc(FDefListProc, FListHandle, Msg, WParam, LParam);
  end;
end;

procedure TFlatComboBox.ComboWndProc (var Message: TMessage; ComboWnd: HWnd; ComboProc: Pointer);
begin
  inherited;
  if (ComboWnd = EditHandle) then
    case Message.Msg of
      WM_SETFOCUS, WM_KILLFOCUS:
        SetSolidBorder;
    end;
end;

procedure TFlatComboBox.WMSetFocus (var Message: TMessage);
begin
  inherited;
  if not (csDesigning in ComponentState) then
  begin
    SetSolidBorder;
    Color := FFocusedColor;
    if not (Style in [csSimple, csDropDown]) then
      InvalidateSelection;
  end;
end;

procedure TFlatComboBox.WMKillFocus (var Message: TMessage);
begin
  inherited;
  if not (csDesigning in ComponentState) then
  begin
    SetSolidBorder;
    Color := FFlatColor;
    if not (Style in [csSimple, csDropDown]) then
      InvalidateSelection;
  end;
end;

procedure TFlatComboBox.CMEnabledChanged (var Msg: TMessage);
begin
  inherited;
  Invalidate;
  fEditLabel.Enabled := Enabled;
end;

procedure TFlatComboBox.CNCommand (var Message: TWMCommand);
var
  R: TRect;
begin
  inherited;
  if Message.NotifyCode in [1, 9, CBN_DROPDOWN, CBN_SELCHANGE] then
  begin
    if not (Style in [csSimple, csDropDown]) then
      InvalidateSelection;
  end;
  if (Message.NotifyCode in [CBN_CLOSEUP]) then
  begin
    R := GetButtonRect;
    Dec(R.Left, 2);
    InvalidateRect(Handle, @R, FALSE);
  end;
end;

procedure TFlatComboBox.WMKeyDown (var Message: TMessage);
var
  S: String;
begin
  S := Text;
  inherited;
  if not (Style in [csSimple, csDropDown]) and (Text <> S) then
    InvalidateSelection;
end;

procedure TFlatComboBox.WMPaint (var Message: TWMPaint);
var
  R: TRect;
  DC: HDC;
  PS: TPaintStruct;
begin
  DC := BeginPaint(Handle, PS);
  try
    R := PS.rcPaint;
    if R.Right > Width - FButtonWidth - 4 then
      R.Right := Width - FButtonWidth - 4;
    FillRect(DC, R, Brush.Handle);
    if RectInRect(GetButtonRect, PS.rcPaint) then
      PaintButton;
    ExcludeClipRect(DC, ClientWidth - FSysBtnWidth - 2, 0, ClientWidth, ClientHeight);