unitascombobox.pas

仿速达界面控件

  with Params do
  begin
    Style := WS_POPUP or WS_BORDER;
    ExStyle := WS_EX_TOOLWINDOW;
    AddBiDiModeExStyle(ExStyle);
    WindowClass.Style := CS_SAVEBITS;
  end;
end;

procedure TDropDownWindow.WMMouseActivate(var Message: TMessage);
begin
  Message.Result := MA_NOACTIVATE;
end;

function TDropDownWindow.GetItems: TStrings;
begin
  Result := FListBox.Items;
end;

function TDropDownWindow.GetForm: TWinControl;
begin
  if (Owner <> nil) and (Owner.Owner <> nil) and (Owner.Owner is TWinControl)
    then
    Result := Owner.Owner as TWinControl
  else
    Result := nil;
end;

procedure TDropDownWindow.WMActivate(var Msg: TWMActivate);
var
  OwnerForm         : TWinControl;
  MDIOwner          : TCustomForm;
begin
  inherited;

  OwnerForm := GetForm;

  if (Msg.Active = WA_ACTIVE) and (OwnerForm <> nil) then
  begin
    SendMessage(OwnerForm.Handle, WM_NCACTIVATE, 1, 0);
    Self.Font.Assign(TCustomASComboBox(Owner).Font);
    TASListBox(FListBox).Font.Assign(TCustomASComboBox(Owner).Font);
    TComboBoxToolBar(FToolBar).Font.Assign(TCustomASComboBox(Owner).Font);
    
    if (OwnerForm is TCustomForm) and (TForm(OwnerForm).FormStyle = fsMDIChild)
      then
    begin
      MDIOwner := Application.MainForm;
      if MDIOwner <> nil then
      begin
        SendMessage(MDIOwner.Handle, WM_NCACTIVATE, 1, 0);
      end;
    end;
  end;

  if (Msg.Active = WA_INACTIVE) then
  begin
    TCustomASComboBox(Owner).CloseUp(False);
    Hide;
  end;
end;

function TDropDownWindow.GetButtons: TStrings;
begin
  Result := TComboBoxToolBar(FToolBar).Buttons;
end;

{ TCustomASComboBox }

procedure TCustomASComboBox.ButtonClick;
begin
  if FIsDropDown then
  begin
    CloseUp(False);
  end
  else
  begin
    DropDown;
  end;
  //FIsDropDown := not FIsDropDown;
  Invalidate;
end;

function TCustomASComboBox.ButtonRect: TRect;
begin
  Result := ClientRect;
  Result.Left := Result.Right - ClientHeight;
end;

constructor TCustomASComboBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FDropDownWindow := TDropDownWindow.Create(Self);
  CustomCursor := True;
  FIsDropDown := False;
  FDropDownCount := 8;
end;

destructor TCustomASComboBox.Destroy;
begin
  FDropDownWindow.Free;
  inherited Destroy;
end;

procedure TCustomASComboBox.CloseUp(Accept: Boolean);
begin
  FDropDownWindow.Hide;
  if Accept then
  begin
    if FDropDownWindow.FListBox.ItemIndex = -1 then
      Text := ''
    else
      Text :=
        FDropDownWindow.FListBox.Items[FDropDownWindow.FListBox.ItemIndex];

  end;
  FIsDropDown := False;
end;

procedure TCustomASComboBox.DropDown;
var
  P                 : TPoint;
  ListWidth         : Integer;
  I, J, K           : Integer;
begin
  if FDropDownCount < Items.Count then
    J := FDropDownCount
  else
    J := Items.Count;
  if J = 0 then
    J := 1;
  //FDropDownWindow.AutoSize := False;
  FDropDownWindow.ClientHeight :=
    TASListBox(FDropDownWindow.FListBox).ItemHeight
    * J + (FDropDownWindow.FListBox.Height -
    FDropDownWindow.FListBox.ClientHeight) + FDropDownWindow.FToolBar.Height;
  FDropDownWindow.Height := FDropDownWindow.FListBox.Height +
    FDropDownWindow.FToolBar.Height;

  //FDropDownWindow.AutoSize := True;
  FDropDownWindow.Color := Color;
  TASListBox(FDropDownWindow.FListBox).Color := Color;
  FDropDownWindow.Font.Assign(Font);
  TASListBox(FDropDownWindow.FListBox).Font.Assign(Font);

  K := 0;
  for I := 0 to FDropDownWindow.Items.Count - 1 do
  begin
    J := Self.Canvas.TextWidth(FDropDownWindow.Items[I]);
    if K < J then
      K := J;
  end;

  if FListBoxAutoWidth then
  begin
    J := 2 * GetSystemMetrics(SM_CXVSCROLL);
    Inc(K, J);
    if K < Self.Width then
      K := Self.Width;
    ListWidth := K;
  end
  else
  begin
    ListWidth := Self.Width;
    SendMessage(FDropDownWindow.FListBox.Handle, LB_SETHORIZONTALEXTENT,
      K {- 1 * GetSystemMetrics(SM_CXVSCROLL)}, 0);
  end;
  FDropDownWindow.ClientWidth := ListWidth;
  P := Parent.ClientToScreen(Point(Left, Top));
  Inc(P.Y, Height);
  if P.X < 0 then
    P.X := 0;
  FDropDownWindow.Top := P.Y;
  FDropDownWindow.Left := P.X;
  FDropDownWindow.Show;
  //FDropDownWindow.FListBox.ItemIndex := Items.IndexOf(Text);

  Invalidate;
  Windows.SetFocus(FDropDownWindow.Handle);
  FIsDropDown := True;
end;

function TCustomASComboBox.GetEditRect: TRect;
begin
  Result := inherited GetEditRect;
  Result.Right := ButtonRect.Left;
end;

procedure TCustomASComboBox.MouseDown(Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin

  Windows.SetFocus(Handle);
  if (PtInRect(ButtonRect, Point(X, Y)) and (Button = mbLeft))
    or (FStyle = cbDropDownList) then
  begin
    ButtonClick;
  end
  else
  begin
    if FIsDropDown then
      CloseUp(False);
    inherited MouseDown(Button, Shift, X, Y);
  end;
end;

procedure TCustomASComboBox.MouseMove(Shift: TShiftState; x,
  y: Integer);
begin
  inherited MouseMove(Shift, x, y);
  if Shift = [] then
  begin
    if (PtInRect(ButtonRect, Point(X, Y))) or (FStyle = cbDropDownList) then
    begin
      Cursor := crDefault;
    end
    else
    begin
      Cursor := crIBeam;
    end;
  end;
end;

procedure TCustomASComboBox.PaintBuffer;
var
  BtnRect           : TRect;
  R                 : TRect;
begin
  case FStyle of
    cbDropDown:
      begin
        inherited PaintBuffer;
      end;
    cbDropDownList:
      begin
        R := GetEditRect;
        if Focused then
        begin
          Canvas.Brush.Color := clHighlight;
          Canvas.FillRect(R);
          Canvas.Brush.Color := clWhite;
          DrawFocusRect(Canvas.Handle, R);
          InflateRect(R, -1, -1);
          Canvas.Brush.Style := bsClear;
          Canvas.Font.Color := clHighlightText;
          DrawText(Canvas, Text, R, DT_LEFT or DT_SINGLELINE or DT_VCENTER);
        end
        else
        begin
          Canvas.Brush.Color := clWhite;
          Canvas.FillRect(R);
          InflateRect(R, -1, -1);
          Canvas.Brush.Style := bsClear;
          Canvas.Font.Color := clWindowText;
          DrawText(Canvas, Text, R, DT_LEFT or DT_SINGLELINE or DT_VCENTER);
        end;
      end;
  end;
  BtnRect := ButtonRect;
  if FIsDropDown then
  begin
    DrawFrameControl(Canvas.Handle, BtnRect, DFC_SCROLL, DFCS_SCROLLCOMBOBOX
      or DFCS_PUSHED);
  end
  else
  begin
    DrawFrameControl(Canvas.Handle, BtnRect, DFC_SCROLL, DFCS_SCROLLCOMBOBOX);
  end;
end;

procedure TCustomASComboBox.WMKillFocus(var Message: TWMKillFocus);
begin
  if (Message.FocusedWnd <> FDropDownWindow.Handle) and (FIsDropDown) then
  begin
    CloseUp(False);
  end;
end;

procedure TCustomASComboBox.MouseUp(Button: TMouseButton;
  Shift: TShiftState; x, y: Integer);
begin
  inherited MouseUp(Button, Shift, x, y);
  if not ((X >= 0) and (Y >= 0) and (X < Self.Width) and (Y < Self.Height)) then
  begin
    CloseUp(False);
  end;
end;

function TCustomASComboBox.GetItems: TStrings;
begin
  Result := FDropDownWindow.Items;
end;

function TCustomASComboBox.GetButtons: TStrings;
begin
  Result := FDropDownWindow.Buttons;
end;

procedure TCustomASComboBox.SetButtons(const Value: TStrings);
begin
  if Value <> nil then
    TComboBoxToolBar(FDropDownWindow.FToolBar).Buttons.Assign(Value);
end;

procedure TCustomASComboBox.SetItems(const Value: TStrings);
begin
  if Value <> nil then
  begin
    FDropDownWindow.FListBox.Items.Assign(Value);
    ItemIndex := -1;
  end;
end;

procedure TCustomASComboBox.SetStyle(const Value: TComboBoxStyle);
begin
  if FStyle <> Value then
  begin
    FStyle := Value;
    case Value of
      cbDropDownList:
        begin
          ReadOnly := True;
          if ItemIndex <> -1 then
            Text := FDropDownWindow.FListBox.Items[ItemIndex]
          else
            Text := '';
        end;
      cbDropDown:
        begin
          ReadOnly := False;
          //Text := FDropDownWindow.FListBox.Items[ItemIndex];
        end;
    end;
    UpdateCarete;
    Invalidate;
  end;
end;

function TCustomASComboBox.GetItemIndex: Integer;
begin
  Result := FDropDownWindow.FListBox.ItemIndex;
end;

procedure TCustomASComboBox.SetItemIndex(const Value: Integer);
begin
  FDropDownWindow.FListBox.ItemIndex := Value;
end;

procedure TCustomASComboBox.ShowCaret;
begin
  case FStyle of
    cbDropDown:
      begin
        inherited ShowCaret;
      end;
    cbDropDownList:
      begin
        HideCaret;
      end;
  end
end;

procedure TCustomASComboBox.WMKeyDown(var Message: TWMKeyDown);
begin
  inherited;
  case FStyle of
    cbDropDown:
      begin
        if Message.CharCode in [VK_UP, VK_DOWN] then
          FDropDownWindow.FListBox.Perform(Message.Msg,
            TMessage(Message).WParam,
            TMessage(Message).LParam);
      end;
    cbDropDownList:
      begin
        if Message.CharCode in [VK_UP, VK_DOWN, VK_LEFT, VK_RIGHT] then
          FDropDownWindow.FListBox.Perform(Message.Msg,
            TMessage(Message).WParam,
            TMessage(Message).LParam);
      end;
  end;
end;

end.