unitascombobox.pas

仿速达界面控件

unit UnitASComboBox;

interface
uses
  Buttons,
  UnitASBase, UnitASEdit, Types, StdCtrls, Dialogs, 
  Messages, Windows, SysUtils, Classes, Contnrs, Imm, Clipbrd,
  Controls, Forms, Menus, Graphics, UnitASUtils;

type
  TComboBoxButtonClick = procedure(Sender: TObject; ButtonIndex: Integer) of
    object;
  TComboBoxStyle = (cbDropDown, cbDropDownList);
type
  TDropDownWindow = class;

  TCustomASComboBox = class(TCustomASEdit)
  private
    FListBoxAutoWidth: Boolean;
    FIsDropDown: Boolean;
    FDropDownWindow: TDropDownWindow;
    FDropDownCount: Integer;
    FStyle: TComboBoxStyle;
    FOnButtonClick: TComboBoxButtonClick;
    function ButtonRect: TRect;
    procedure ButtonClick;
    function GetItems: TStrings;
    function GetButtons: TStrings;
    procedure SetButtons(const Value: TStrings);
    procedure SetItems(const Value: TStrings);
    procedure SetStyle(const Value: TComboBoxStyle);
    function GetItemIndex: Integer;
    procedure SetItemIndex(const Value: Integer);
  protected
    function GetEditRect: TRect; override;
    procedure PaintBuffer; override;
    procedure MouseMove(Shift: TShiftState; x: Integer; y: Integer);
      override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X: Integer; Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; x: Integer;
      y: Integer); override;
    procedure DropDown;
    procedure CloseUp(Accept: Boolean);

    procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
    property ListBoxAutoWidth: Boolean read FListBoxAutoWidth write
      FListBoxAutoWidth;
    property Style: TComboBoxStyle read FStyle write SetStyle;
    procedure ShowCaret; override;
    procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    property DropDownCount: Integer read FDropDownCount write FDropDownCount;
    property Items: TStrings read GetItems write SetItems;
    property ItemIndex: Integer read GetItemIndex write SetItemIndex;
    property Buttons: TStrings read GetButtons write SetButtons;
    property OnButtonClick: TComboBoxButtonClick read FOnButtonClick
      write FOnButtonClick;
  end;

  TASComboBox = class(TCustomASComboBox)
  published
    property Borderstyle;
    property ListBoxAutoWidth;
    property DropDownCount;
    property Items;
    property Buttons;
    property OnButtonClick;
    property Style;
  end;

  TDropDownWindow = class(TForm)
  private
    FListBox: TCustomListBox;
    FToolBar: TASBase;
    function GetItems: TStrings;
    procedure WMMouseActivate(var Message: TMessage); message WM_MOUSEACTIVATE;
    procedure WMActivate(var Msg: TWMActivate); message WM_ACTIVATE;
    function GetForm: TWinControl;
    function GetButtons: TStrings;
  protected
    procedure CreateParams(var Params: TCreateParams); override;

  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property Items: TStrings read GetItems;
    property Buttons: TStrings read GetButtons;
  end;

implementation

type
  TASListBox = class(TCustomListBox)
  private
    FComboBox: TCustomASComboBox;
  protected
    property ItemHeight;
    property Color;
    property Font;
    property IntegralHeight;
    procedure Click; override;
    procedure SetItemIndex(const Value: Integer); override;
    //procedure KeyDown(var Key: Word; Shift: TShiftState); override;

  public
    constructor Create(AOwner: TComponent); override;

  end;

  { TASListBox }

procedure TASListBox.Click;
begin
  inherited Click;
  FComboBox.CloseUp(True);
end;

constructor TASListBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FComboBox := TCustomASComboBox(AOwner.Owner);
  BorderStyle := bsNone;
end;

type
  TButtonsStatues = (bsDefault, bsAcitve, bsPressDown);

type
  TComboBoxToolBar = class(TASBase)
  private
    FComboBox: TCustomASComboBox;
    FButtons: TStrings;
    FActiveButtonIndex: Integer;
    FActiveButtonStatues: TButtonsStatues;
    FLBtnDown: Boolean;
    procedure ButtonsChange(Sender: TObject);

  protected
    function ButtonRect(Index: Integer): TRect;
    procedure Paint; override;
    procedure DoButtonClick(Index: Integer);
    property Buttons: TStrings read FButtons;
    procedure DrawButton(ACanvas: TCanvas; Index: Integer; Statues:
      TButtonsStatues);
    procedure CMMouseleave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X: Integer; Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X: Integer;
      Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X: Integer; Y: Integer);
      override;

  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  end;

procedure TASListBox.SetItemIndex(const Value: Integer);
begin
  inherited SetItemIndex(Value);
  FComboBox.CloseUp(True);
end;

{ TComboBoxToolBar }

function TComboBoxToolBar.ButtonRect(Index: Integer): TRect;
var
  ButtonWidth       : Integer;
begin
  Result := ClientRect;
  Inc(Result.Top, 1);
  ButtonWidth := ClientWidth div FButtons.Count;
  Result.Left := Index * ButtonWidth;
  Result.Right := (Index + 1) * ButtonWidth;
end;

procedure TComboBoxToolBar.ButtonsChange(Sender: TObject);
begin
  if FButtons.Count = 0 then
    Self.Height := 0
  else
    Self.Height := 21;
end;

procedure TComboBoxToolBar.CMMouseleave(var Message: TMessage);
begin
  if FActiveButtonStatues <> bsPressDown then
  begin
    FActiveButtonIndex := -1;
    Invalidate;
  end;
end;

constructor TComboBoxToolBar.Create(AOwner: TComponent);
begin
  inherited;
  FActiveButtonIndex := -1;
  FActiveButtonStatues := bsDefault;
  FButtons := TStringList.Create;
  TStringList(FButtons).OnChange := ButtonsChange;
  FLBtnDown := False;
  FComboBox := TCustomASComboBox(AOwner.Owner);
end;

destructor TComboBoxToolBar.Destroy;
begin
  FButtons.Free;
  inherited;
end;

procedure TComboBoxToolBar.DoButtonClick(Index: Integer);
begin
  FComboBox.CloseUp(False);
  if Assigned(FComboBox.FOnButtonClick) then
    FComboBox.FOnButtonClick(FComboBox, Index);
end;

procedure TComboBoxToolBar.DrawButton(ACanvas: TCanvas; Index: Integer; Statues:
  TButtonsStatues);
var
  BtnRect           : TRect;
begin
  BtnRect := ButtonRect(Index);
  ACanvas.Brush.Color := clWhite;
  ACanvas.FillRect(BtnRect);
  case Statues of
    bsDefault:
      begin
        ACanvas.FillRect(BtnRect);
      end;
    bsAcitve:
      begin
        ACanvas.Pen.Color := clBlue;
        ACanvas.Rectangle(BtnRect);
        ACanvas.Pen.Color := clWhite;
        InflateRect(BtnRect, -1, -1);
        DrawButtonFace(ACanvas, BtnRect, 1, bsNew, False, False, False);
      end;
    bsPressDown:
      begin
        ACanvas.Pen.Color := clBlue;
        ACanvas.Rectangle(BtnRect);
        ACanvas.Pen.Color := clWhite;
        InflateRect(BtnRect, -1, -1);
        DrawButtonFace(ACanvas, BtnRect, 1, bsNew, False, True, False);
        //ACanvas.FillRect(BtnRect);
      end;
  end;
  ACanvas.Brush.Style := bsClear;
  DrawText(ACanvas, FButtons[Index], BtnRect, DT_CENTER or DT_SINGLELINE or
    DT_VCENTER);
end;

procedure TComboBoxToolBar.MouseDown(Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  I                 : Integer;
begin
  if Button <> mbLeft then
    Exit;
  for I := 0 to FButtons.Count - 1 do
  begin
    if PtInRect(ButtonRect(I), Point(X, Y)) then
    begin
      FActiveButtonIndex := I;
      FActiveButtonStatues := bsPressDown;
      FLBtnDown := True;
      Invalidate;
      Break;
    end;
  end;
end;

procedure TComboBoxToolBar.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  I                 : Integer;
begin
  if not FLBtnDown then
  begin
    for I := 0 to FButtons.Count - 1 do
    begin
      if PtInRect(ButtonRect(I), Point(X, Y)) then
      begin
        if FActiveButtonIndex <> I then
        begin
          FActiveButtonIndex := I;

          FActiveButtonStatues := bsAcitve;

          Invalidate;
        end;
        Break;
      end;
    end;
  end;
end;

procedure TComboBoxToolBar.MouseUp(Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  I                 : Integer;
begin
  if Button <> mbLeft then
    Exit;
  if FLBtnDown then
  begin
    FActiveButtonStatues := bsDefault;
    for I := 0 to FButtons.Count - 1 do
    begin
      if PtInRect(ButtonRect(I), Point(X, Y)) then
      begin
        if FActiveButtonIndex = I then
        begin
          //ShowMessage(IntToStr(I));
          DoButtonClick(I);
        end;
        FActiveButtonStatues := bsAcitve;
        Break;
      end;
    end;
    FLBtnDown := False;
    Invalidate;
  end;
end;

procedure TComboBoxToolBar.Paint;
var
  I                 : Integer;
  DoubleBuffer      : TBitmap;
begin
  DoubleBuffer := TBitmap.Create;
  try
    DoubleBuffer.Height := ClientHeight;
    DoubleBuffer.Width := ClientWidth;
    DoubleBuffer.Canvas.MoveTo(0, 0);
    DoubleBuffer.Canvas.LineTo(ClientWidth, 0);
    DoubleBuffer.Canvas.Font.Assign(Self.Font);

    for I := 0 to FButtons.Count - 1 do
    begin
      if I = FActiveButtonIndex then
      begin
        DrawButton(DoubleBuffer.Canvas, I, FActiveButtonStatues);
      end
      else
      begin
        DrawButton(DoubleBuffer.Canvas, I, bsDefault);
      end;
    end;
  finally
    Canvas.CopyRect(ClientRect, DoubleBuffer.Canvas, ClientRect);
  end;
  DoubleBuffer.Free;
end;

{ TDropDownWindow }

constructor TDropDownWindow.Create(AOwner: TComponent);
begin
  inherited CreateNew(AOwner);
  FListBox := TASListBox.Create(Self);
  FListBox.Parent := Self;
  FListBox.Align := alClient;
  //TASListBox(FListBox).IntegralHeight := True;
  //TASListBox(FListBox).BorderStyle := bsSingle;
  BorderStyle := bsNone;
  FToolBar := TComboBoxToolBar.Create(Self);
  FToolBar.Parent := Self;
  FToolBar.Align := alBottom;

  ControlStyle := ControlStyle + [csNoDesignVisible, csReplicatable];
end;

destructor TDropDownWindow.Destroy;
begin
  FListBox.Free;
  inherited Destroy;
end;

procedure TDropDownWindow.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);