xpcombo.pas

非常好的xp界面控件

    FBGImage.FreeImage;
  except end;

  FBGImage.Assign (AValue);
end;

procedure TxpComboStyle.SetDefaultImageIndex (AValue : Integer);
begin
  if FDefaultImageIndex <> AValue then
  begin
    if AValue < -1 then AValue := -1;
    FDefaultImageIndex := AValue;
    SendMessage (FxpComboBox.Handle, WM_NCPAINT, 0, 0);
  end;
end;


procedure TxpComboStyle.SetDefaultListImageIndex (AValue : Integer);
begin
  if FDefaultListImageIndex <> AValue then
  begin
    if AValue < -1 then AValue := -1;
    FDefaultListImageIndex := AValue;
    SendMessage (FxpComboBox.Handle, WM_NCPAINT, 0, 0);
  end;
end;


procedure TxpComboStyle.SetButtonStyle (AValue : TxpComboButtonStyle);
begin
  if FButtonStyle <> AValue then
  begin
    FButtonStyle := AValue;
    SendMessage (FxpComboBox.Handle, WM_NCPAINT, 0, 0);
  end;
end;

procedure TxpComboStyle.SetAutoSearch (Value : Boolean);
begin
  if FAutoSearch <> Value then
  begin
    FAutoSearch := Value;
  end;
end;

{******************************************************************************}

constructor TxpComboBox.Create(AOwner: TComponent);
begin
  inherited Create (AOwner);
  FCanvas := TControlCanvas.Create;
  FCanvas.Control := Self;

  FActive := False;
  FFocused := False;

  FxpStyle := TxpComboStyle.Create (self);

  FBackground := TBitmap.Create;

  FLocating := False;
  FOldText := '';
end;

destructor TxpComboBox.Destroy;
begin
  try FCanvas.Free; except end;
  try FxpStyle.Free; except end;
  try FBackground.Free; except end;
  inherited;
end;

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

  if FxpStyle.Active then
  begin
    if Style = csOwnerDrawVariable then
      Params.Style := Params.Style or CBS_OWNERDRAWVARIABLE
    else
      Params.Style := Params.Style or CBS_OWNERDRAWFIXED;
  end;
end;

procedure TxpComboBox.WMNCPaint (var Message : TWMNCPaint);
var
  DC : hDC;
  Pen : hPen;
  Brush : hBrush;
  UpdateRect : TRect;
  Bmp : TBitmap;
begin
  if not FxpStyle.Active then
  begin
    inherited;
    exit;
  end;

  DC := GetWindowDC (Handle);
  GetWindowRect (Handle, UpdateRect);
  OffsetRect (UpdateRect, - UpdateRect.Left, - UpdateRect.Top);
  DrawBorder (DC);

  if Assigned (FxpStyle.Images) then
  begin
    Canvas.Handle := DC;
    Brush := CreateSolidBrush (ColorToRGB (Color));
    FillRect (DC, Rect (1, 1, FxpStyle.Images.Width + 5, Height-1), Brush);
    DeleteObject (Brush);

    Bmp := TBitmap.Create;
    try
      Bmp.Width := FxpStyle.Images.Width;
      Bmp.Height := FxpStyle.Images.Height;

      if (ItemIndex >= 0) and (ItemIndex < FxpStyle.Images.Count) then
        FxpStyle.Images.GetBitmap (Self.ItemIndex, Bmp)
      else
      if (ItemIndex < 0) then
      begin
        if FxpStyle.FDefaultImageIndex >= 0 then
          FxpStyle.Images.GetBitmap (FxpStyle.FDefaultImageIndex, Bmp);
      end
      else
      begin
        if FxpStyle.FDefaultListImageIndex >= 0 then
          FxpStyle.Images.GetBitmap (FxpStyle.FDefaultListImageIndex, Bmp);
      end;

      if not Enabled then ConvertBitmapToGrayscale (Bmp);

      Canvas.Draw (2, (Height - FxpStyle.Images.Height) div 2, Bmp);
    finally
      Bmp.Free;
    end;
  end;


  if Style <> csSimple then
    DrawButton (DC, Rect (UpdateRect.Right - FxpStyle.ButtonWidth - 2, UpdateRect.Top+1,
                UpdateRect.Right- 1, UpdateRect.Bottom-1), FxpStyle.ButtonStyle);

  ReleaseDC (Handle, DC); 
end;

procedure TxpComboBox.MouseDown (var Message : TWMLBUTTONDOWN);
var
  OldState : Boolean;
begin
  if not FxpStyle.Active then
  begin
    inherited;
    exit;
  end;

  OldState := Self.DroppedDown;
  inherited;
  if OldState = Self.DroppedDown then
    Self.DroppedDown := not OldState;
end;

procedure TxpComboBox.WMNCCalcSize (var Message : TWMNCCalcSize);
begin
  inherited;
  if not FxpStyle.Active then exit;

  if Assigned (FxpStyle.Images) then
    Inc (Message.CalcSize_Params^.rgrc[0].Left, FxpStyle.Images.Width + 4);

  InflateRect (Message.CalcSize_Params^.rgrc[0], -1, -1);
  if Style <> csSimple then
  begin
    Dec (Message.CalcSize_Params^.rgrc[0].Right, FxpStyle.FButtonWidth + 1);
  end;
end;

procedure TxpComboBox.WMMeasureItem (var Message : TWMMeasureItem);
begin
  inherited;
  if (not FxpStyle.Active) or (not FxpStyle.AutoHeight) then exit;

  if Assigned (FxpStyle.Images) then
  begin
    if FxpStyle.Images.Height + 2 > Message.MeasureItemStruct.itemHeight then
      Message.MeasureItemStruct.itemHeight := FxpStyle.Images.Height + 2;
  end;
  Message.Result := 1;
end;

procedure TxpComboBox.WMDrawItem (var Message : TWMDrawItem);
var
  ItemRect : TRect;
  EditRect : TRect;
  EditCanvas : TCanvas;
  DropRect : TRect;
begin
  if not FxpStyle.Active then
  begin
    inherited;
    exit;
  end;

  case Message.DrawItemStruct.CtlType of
    ODT_LISTBOX:
    begin
      ItemRect := Message.DrawItemStruct.rcItem;
      Canvas.Handle := Message.DrawItemStruct.hDC;
      /////////////////////////////////////////////


      if FxpStyle.BGStyle = cbgsNone then
      begin
        Canvas.Brush.Color := Color;
        Canvas.FillRect (Message.DrawItemStruct.rcItem);
        Canvas.Brush.Style := bsClear;
      end
      else
      begin

        SendMessage (Handle, CB_GETDROPPEDCONTROLRECT, 0, LongInt (@DropRect));
        OffsetRect (DropRect, -DropRect.Left, -DropRect.Top);
        if Items.Count = 0 then ItemRect := DropRect;

        BitBlt(Canvas.Handle, ItemRect.Left, ItemRect.Top,
               ItemRect.Right - ItemRect.Left, ItemRect.Bottom -ItemRect.Top,
               FBackground.Canvas.Handle, ItemRect.Left, ItemRect.Top,
               SRCCOPY);
      end;


      ////////////////////////////////////////////////


      if Message.DrawItemStruct.itemAction in [ODA_SELECT, ODA_FOCUS] then
      begin
        Dec ( ItemRect.Bottom );
        if Message.DrawItemStruct.itemState and ODS_SELECTED = ODS_SELECTED then
          GradientFillRect (Canvas, ItemRect, FxpStyle.SelStartColor,
            FxpStyle.SelEndColor, FxpStyle.SelGradientFillDir, (ItemRect.Right - ItemRect.Left) div 2);
      end;

      if Assigned (FxpStyle.Images) then
      begin
        if (Message.DrawItemStruct.itemID >= 0) and (Message.DrawItemStruct.itemID < FxpStyle.Images.Count) then
          FxpStyle.Images.Draw (Canvas, ItemRect.Left + 2, ItemRect.Top+2,  Message.DrawItemStruct.itemID)
        else
          FxpStyle.Images.Draw (Canvas, ItemRect.Left + 2, ItemRect.Top+2,  FxpStyle.DefaultListImageIndex);
        Inc (ItemRect.Left, FxpStyle.Images.Width);
      end;

      Inc (ItemRect.Left, 4);

      Canvas.Brush.Color := clNone;
      Canvas.Brush.Style := BSCLEAR;
      SelectObject (Canvas.Handle, Font.Handle);
      SetTextColor (Canvas.Handle, ColorToRGB (Font.Color));
      DrawText (Canvas.Handle, PChar (Items [Message.DrawItemStruct.itemID]),
               Length(Items [Message.DrawItemStruct.itemID]),
               ItemRect,
               DT_VCENTER or DT_END_ELLIPSIS or DT_SINGLELINE or DT_Left);

      //Hottracking items
      if (FxpStyle.FHotTrack) and (Style in [csDropDownList, csOwnerDrawFixed, csOwnerDrawVariable]) then
      begin
        SendMessage (Handle, WM_NCPAINT, 0, 0);

        EditCanvas := TCanvas.Create;
        try
          EditCanvas.Handle := GetWindowDC (Handle);
          EditRect := ClientRect;
          if Assigned (FxpStyle.Images) then
            OffsetRect (EditRect, FxpStyle.Images.Width + 4, 0);
          InflateRect (EditRect, -2, -2);
          DrawEditText (EditCanvas, EditRect, Message.DrawItemStruct.itemID, False);
          ReleaseDC (Handle, EditCanvas.Handle);
        finally
          EditCanvas.Free;
        end;
      end;

    end;
  end;
end;

procedure TxpComboBox.WMPaint(var Message: TWMPaint);
var
  DC : hDC;
  PS : TPaintStruct;
  ItemRect : TRect;
begin
  if (not FxpStyle.Active) then
  begin
    inherited;
    exit;
  end;

  if Message.DC = 0 then DC := BeginPaint(Handle, PS) else DC := Message.DC;
  try
    Canvas.Handle := DC;
    DrawEditText (Canvas, ClientRect, Self.ItemIndex, FFocused);
  finally
    if Message.DC = 0 then EndPaint(Handle, PS);
  end;
end;

procedure TxpComboBox.DrawEditText (ACanvas : TCanvas; ARect : TRect; AItemIndex : Integer; IsSelected : Boolean);
begin
  ACanvas.Brush.Color := Color;
  InflateRect (ARect, 1, 1);
  ACanvas.FillRect (ARect);
  InflateRect (ARect, -3, -3);
  Inc (ARect.Left);
  Inc (ARect.Top);
  if not (Style in [csSimple, csDropDown]) then
  begin
    if IsSelected and (not DroppedDown) then
    begin
      GradientFillRect (ACanvas, ARect, FxpStyle.SelStartColor,
          FxpStyle.SelEndColor, FxpStyle.SelGradientFillDir, (ARect.Right - ARect.Left) div 2);
    end;
    ACanvas.Brush.Color := clNone;
    ACanvas.Brush.Style := BSCLEAR;
    ACanvas.Font.Assign (Self.Font);
    InflateRect (ARect, -2, 0);

    if not Enabled then ACanvas.Font.Color := clGrayText;

    SelectObject (ACanvas.Handle, Self.Font.Handle);
    SetTextColor (ACanvas.Handle, ColorToRGB (ACanvas.Font.Color));
    DrawText (ACanvas.Handle, PChar (Items [AItemIndex]),
              Length(Items [AItemIndex]),
              ARect,
              DT_VCENTER or DT_END_ELLIPSIS or DT_SINGLELINE or DT_LEFT);
    end;

end;

procedure TxpComboBox.DrawBorder (DC : hDC);
var
  Brush : hBrush;
  BoundRect : TRect;
begin
  GetWindowRect (Handle, BoundRect);
  OffsetRect (BoundRect, - BoundRect.Left, - BoundRect.Top);

  if FFocused or FActive then
    Brush := CreateSolidBrush (ColorToRGB (FxpStyle.ActiveBorderColor))
  else
    Brush := CreateSolidBrush (ColorToRGB (FxpStyle.InActiveBorderColor));

  try
    FrameRect (DC, BoundRect, Brush);
  finally
    DeleteObject (Brush);
  end;