flatboxs.pas

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

  if Value <> FUseAdvColors then
  begin
    FUseAdvColors := Value;
    CalcAdvColors;
    Invalidate;
  end;
end;

procedure TFlatDBComboBox.CMSysColorChange (var Message: TMessage);
begin
  if FUseAdvColors then
    CalcAdvColors;
  Invalidate;
end;

procedure TFlatDBComboBox.CMParentColorChanged (var Message: TWMNoParams);
begin
  if FUseAdvColors then
    CalcAdvColors;
  Invalidate;
end;

procedure TFlatDBComboBox.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 TFlatDBComboBox.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 TFlatDBComboBox.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 TFlatDBComboBox.WMSetFocus (var Message: TMessage);
begin
  inherited;
  if not (csDesigning in ComponentState) then
  begin
    SetSolidBorder;
    if not (Style in [csSimple, csDropDown]) then
      InvalidateSelection;
  end;
end;

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

procedure TFlatDBComboBox.CMEnabledChanged (var Msg: TMessage);
begin
  inherited;
  Invalidate;
end;

procedure TFlatDBComboBox.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 TFlatDBComboBox.WMKeyDown (var Message: TMessage);
var
  S: String;
begin
  S := Text;
  inherited;
  if not (Style in [csSimple, csDropDown]) and (Text <> S) then
    InvalidateSelection;
end;

procedure TFlatDBComboBox.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);
    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 TFlatDBComboBox.WMNCPaint (var Message: TMessage);
begin
  inherited;
  RedrawBorders;
end;

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

procedure TFlatDBComboBox.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 TFlatDBComboBox.GetButtonRect: TRect;
begin
  GetWindowRect(Handle, Result);
  OffsetRect(Result, -Result.Left, -Result.Top);
  Inc(Result.Left, ClientWidth - FButtonWidth);
  OffsetRect(Result, -1, 0);
end;

procedure TFlatDBComboBox.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 TFlatDBComboBox.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));

    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 TFlatDBComboBox.GetSolidBorder: Boolean;
begin
  Result := ( (csDesigning in ComponentState) and Enabled) or
    (not(csDesigning in ComponentState) and
    (DroppedDown or (GetFocus = Handle) or (GetFocus = EditHandle)) );
end;

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

procedure TFlatDBComboBox.RedrawBorders;
begin
  PaintBorder;
  if Style <> csSimple then
    PaintButton;
end;
{ TFlatColorBox }
const
  StdColors = 16;
  StdColorValues: array [1..StdColors] of TColor = (
    clBlack, clMaroon, clGreen, clOlive, clNavy, clPurple, clTeal, clGray,
    clSilver, clRed, clLime, clYellow, clBlue, clFuchsia, clAqua, clWhite);

constructor TFlatColorBox.Create (AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle - [csFixedHeight] + [csOpaque];
  TControlCanvas(Canvas).Control := Self;
  Style            := csOwnerDrawFixed;
  FButtonWidth     := 11;
  FSysBtnWidth     := GetSystemMetrics(SM_CXVSCROLL);
  FListInstance    := MakeObjectInstance(ListWndProc);
  FDefListProc     := nil;
  FArrowColor      := clBlack;
  FArrowBackgroundColor := $00C5D6D9;
  FBorderColor     := $004080FF;
  FHighlightColor  := clHighlight;
  FUseAdvColors    := False;
  FAdvColorBorder  := 50;
  FAdvColorArrowBackground := 10;
  FAdvColorHighlight := 30;
  FShowNames       := True;
  FColorBoxWidth   := 12;
  FValue           := clBlack;
  FColorDlg        := TColorDialog.Create(Self);
  FLabelPosition   := lpLeft;
  FLabelSpacing    := 3;
  SetupInternalLabel;
end;

destructor TFlatColorBox.Destroy;
begin
  FColorDlg.Free;
  FreeObjectInstance(FListInstance);
  inherited;
end;

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

procedure TFlatColorBox.CMBidimodechanged(var Message: TMessage);
begin
  inherited;
  FListLabel.BiDiMode := BiDiMode;
end;

procedure TFlatColorBox.CMVisiblechanged(var Message: TMessage);
begin
  inherited;
  FListLabel.Visible := Visible;
end;

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

procedure TFlatColorBox.SetName(const Value: TComponentName);
begin
    if (csDesigning in ComponentState) and ((FListLa