flatboxs.pas

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

    PaintWindow(DC);
    if (Style = csDropDown) and DroppedDown then
    begin
      R := ClientRect;
      InflateRect(R, -2, -2);
      R.Right := Width - FButtonWidth - 3;
      Canvas.Brush.Color := clWindow;
      Canvas.FrameRect(R);
    end
    else
      if Style <> csDropDown then
        InvalidateSelection;
  finally
    EndPaint(Handle, PS);
  end;
  RedrawBorders;
  Message.Result := 0;
end;

procedure TFlatComboBox.WMNCPaint (var Message: TMessage);
begin
  inherited;
  RedrawBorders;
end;

procedure TFlatComboBox.CMFontChanged (var Message: TMessage);
begin
  inherited;
  ItemHeight := 13;
  RecreateWnd;
end;

procedure TFlatComboBox.InvalidateSelection;
var
  R: TRect;
begin
  R := ClientRect;
  InflateRect(R, -2, -3);
  R.Left := R.Right - FButtonWidth - 8;
  Dec(R.Right, FButtonWidth + 3);
  if (GetFocus = Handle) and not DroppedDown then
    Canvas.Brush.Color := clHighlight
  else
    Canvas.Brush.Color := Color;
  Canvas.Brush.Style := bsSolid;
  Canvas.FillRect(R);
  if (GetFocus = Handle) and not DroppedDown then
  begin
    R := ClientRect;
    InflateRect(R, -3, -3);
    Dec(R.Right, FButtonWidth + 2);
    Canvas.FrameRect(R);
    Canvas.Brush.Color := clWindow;
  end;
  ExcludeClipRect(Canvas.Handle, ClientWidth - FSysBtnWidth - 2, 0, ClientWidth, ClientHeight);
end;

function TFlatComboBox.GetButtonRect: TRect;
begin
  GetWindowRect(Handle, Result);
  OffsetRect(Result, -Result.Left, -Result.Top);
  Inc(Result.Left, ClientWidth - FButtonWidth);
  OffsetRect(Result, -1, 0);
end;

procedure TFlatComboBox.PaintButton;
var
  R: TRect;
  x, y: Integer;
begin
  R := GetButtonRect;
  InflateRect(R, 1, 0);

  Canvas.Brush.Color := FArrowBackgroundColor;
  Canvas.FillRect(R);
  Canvas.Brush.Color := FBorderColor;
  Canvas.FrameRect(R);

  x := (R.Right - R.Left) div 2 - 6 + R.Left;
  if DroppedDown then
    y := (R.Bottom - R.Top) div 2 - 1 + R.Top
  else
    y := (R.Bottom - R.Top) div 2 - 1 + R.Top;

  if Enabled then
  begin
    canvas.Brush.Color := FArrowColor;
    canvas.Pen.Color := FArrowColor;
    if DroppedDown then
      canvas.Polygon([Point(x + 4, y + 2), Point(x + 8, y + 2), Point(x + 6, y)])
    else
      canvas.Polygon([Point(x + 4, y), Point(x + 8, y), Point(x + 6, y + 2)]);
  end
  else
  begin
    canvas.Brush.Color := clWhite;
    canvas.Pen.Color := clWhite;
    Inc(x); Inc(y);
    if DroppedDown then
      canvas.Polygon([Point(x + 4, y + 2), Point(x + 8, y + 2), Point(x + 6, y)])
    else
      canvas.Polygon([Point(x + 4, y), Point(x + 8, y), Point(x + 6, y + 2)]);
    Dec(x); Dec(y);
    canvas.Brush.Color := clGray;
    canvas.Pen.Color := clGray;
    if DroppedDown then
      canvas.Polygon([Point(x + 4, y + 2), Point(x + 8, y + 2), Point(x + 6, y)])
    else
      canvas.Polygon([Point(x + 4, y), Point(x + 8, y), Point(x + 6, y + 2)]);
  end;
  ExcludeClipRect(Canvas.Handle, ClientWidth - FSysBtnWidth, 0, ClientWidth, ClientHeight);
end;

procedure TFlatComboBox.PaintBorder;
var
  DC: HDC;
  R: TRect;
  BtnFaceBrush, WindowBrush: HBRUSH;
begin
  DC := GetWindowDC(Handle);

  GetWindowRect(Handle, R);
  OffsetRect(R, -R.Left, -R.Top);
  Dec(R.Right, FButtonWidth + 1);
  try
    BtnFaceBrush := CreateSolidBrush(ColorToRGB(FBorderColor));
    WindowBrush  := CreateSolidBrush(ColorToRGB(Color));
    if (not(csDesigning in ComponentState) and
      (Focused or (MouseInControl and not(Screen.ActiveControl is TFlatComboBox)))) then
       Color := FFocusedColor
    else
       Color := FFlatColor;
    FrameRect(DC, R, BtnFaceBrush);
    InflateRect(R, -1, -1);
    FrameRect(DC, R, WindowBrush);
    InflateRect(R, -1, -1);
    FrameRect(DC, R, WindowBrush);
  finally
    ReleaseDC(Handle, DC);
  end;
  DeleteObject(WindowBrush);
  DeleteObject(BtnFaceBrush);
end;

function TFlatComboBox.GetSolidBorder: Boolean;
begin
  Result := ( (csDesigning in ComponentState) and Enabled) or
    (not(csDesigning in ComponentState) and
    (DroppedDown or (GetFocus = Handle) or (GetFocus = EditHandle)) );
end;

procedure TFlatComboBox.SetSolidBorder;
var
  sb: Boolean;
begin
  sb := GetSolidBorder;
  if sb <> FSolidBorder then begin
    FSolidBorder := sb;
    RedrawBorders;
  end;
end;

procedure TFlatComboBox.RedrawBorders;
begin
  PaintBorder;
  if Style <> csSimple then
     PaintButton;
end;

procedure TFlatComboBox.CMBidimodechanged(var Message: TMessage);
begin
  inherited;
  FEditLabel.BiDiMode := BiDiMode;
end;

procedure TFlatComboBox.CMVisiblechanged(var Message: TMessage);
begin
  inherited;
  FEditLabel.Visible := Visible;
end;

procedure TFlatComboBox.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (AComponent = FEditLabel) and (Operation = opRemove) then
     FEditLabel := nil;
end;

procedure TFlatComboBox.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
  inherited SetBounds(ALeft, ATop, AWidth, AHeight);
  SetLBPosition(FLabelPosition);
end;

procedure TFlatComboBox.SetLBPosition(const Value: TLabelPosition);
var
  P: TPoint;
begin
  if FEditLabel = nil then exit;
  FLabelPosition := Value;
  case Value of
    lpAbove: P := Point(Left, Top - FEditLabel.Height - FLabelSpacing);
    lpBelow: P := Point(Left, Top + Height + FLabelSpacing);
    lpLeft : P := Point(Left - FEditLabel.Width - FLabelSpacing,
                    Top + ((Height - FEditLabel.Height) div 2));
    lpRight: P := Point(Left + Width + FLabelSpacing,
                    Top + ((Height - FEditLabel.Height) div 2));
  end;
  FEditLabel.SetBounds(P.x, P.y, FEditLabel.Width, FEditLabel.Height);
end;

procedure TFlatComboBox.SetLabelSpacing(const Value: Integer);
begin
  FLabelSpacing := Value;
  SetLBPosition(FLabelPosition);
end;

procedure TFlatComboBox.SetName(const Value: TComponentName);
begin
  if (csDesigning in ComponentState) and ((FEditlabel.GetTextLen = 0) or
     (CompareText(FEditLabel.Caption, Name) = 0)) then
    FEditLabel.Caption := Value;
  inherited SetName(Value);
  if csDesigning in ComponentState then
     Text := '';
end;

procedure TFlatComboBox.SetParent(AParent: TWinControl);
begin
  inherited SetParent(AParent);
  if FEditLabel = nil then exit;
  FEditLabel.Parent := AParent;
  FEditLabel.Visible := True;
end;

procedure TFlatComboBox.SetupInternalLabel;
begin
  if Assigned(FEditLabel) then exit;
  FEditLabel := TBOXLabel.Create(Self);
  FEditLabel.FreeNotification(Self);
  FEditLabel.Transparent  := True;
  FEditLabel.FocusControl := Self;
end;

procedure TFlatComboBox.SetParentColor(const Value: Boolean);
begin
  if Value <> FParentColor then begin
    FParentColor := Value;
    if FParentColor then begin
      if Parent <> nil then
         FFlatColor := TForm(Parent).Color;
      RedrawBorders;
    end;
  end;
end;

procedure TFlatComboBox.CMMouseEnter(var Message: TMessage);
begin
  inherited;
  if (GetActiveWindow <> 0) then
  begin
    MouseInControl := True;
    RedrawBorders;
  end;
end;

procedure TFlatComboBox.CMMouseLeave(var Message: TMessage);
begin
 inherited;
  MouseInControl := False;
  RedrawBorders;
end;

{ TBOXLabel }

constructor TBOXLabel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Name := 'Label';  { do not localize }
  SetSubComponent(True);
  if Assigned(AOwner) then
     Caption := AOwner.Name;
end;

procedure TBOXLabel.AdjustBounds;
begin
  inherited AdjustBounds;
  if Owner is TFlatComboBox then begin
    with Owner as TFlatComboBox do
      SetLBPosition(LabelPosition);
  end;
  if Owner is TFlatListBox then begin
    with Owner as TFlatListBox do
      SetLBPosition(LabelPosition);
  end;
  if Owner is TFlatCheckListBox then begin
    with Owner as TFlatCheckListBox do
      SetLBPosition(LabelPosition);
  end;
  if Owner is TFlatColorBox then begin
    with Owner as TFlatColorBox do
      SetLBPosition(LabelPosition);
  end;
end;

function TBOXLabel.GetHeight: Integer;
begin
  Result := inherited Height;
end;

function TBOXLabel.GetLeft: Integer;
begin
  Result := inherited Left;
end;

function TBOXLabel.GetTop: Integer;
begin
  Result := inherited Top;
end;

function TBOXLabel.GetWidth: Integer;
begin
  Result := inherited Width;
end;

procedure TBOXLabel.SetHeight(const Value: Integer);
begin
  SetBounds(Left, Top, Width, Value);
end;

procedure TBOXLabel.SetWidth(const Value: Integer);
begin
  SetBounds(Left, Top, Value, Height);
end;

{TFlatDBComboBox}

constructor TFlatDBComboBox.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;
  FBorderColor := $004080FF;
  FUseAdvColors := False;
  FAdvColorBorder := 50;
  FAdvColorArrowBackground := 10;
end;

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

procedure TFlatDBComboBox.SetColors (Index: Integer; Value: TColor);
begin
  case Index of
    0: FArrowColor := Value;
    1: FArrowBackgroundColor := Value;
    2: FBorderColor := Value;
  end;
  Invalidate;
end;

procedure TFlatDBComboBox.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 TFlatDBComboBox.SetAdvColors (Index: Integer; Value: TAdvColors);
begin
  case Index of
    0: FAdvColorBorder := Value;
    1: FAdvColorArrowBackground := Value;
  end;
  CalcAdvColors;
  Invalidate;
end;

procedure TFlatDBComboBox.SetUseAdvColors (Value: Boolean);
begin