Создание прозрачного TListBox в Delphi - PullRequest
Новая
       58

Создание прозрачного TListBox в Delphi

0 голосов
/ 31 декабря 2011

Прозрачный TListBox: 

type
   TListBox = class(StdCtrls.TListBox)
   private
     { Private declarations }
   protected
     { Protected declarations }
     procedure CreateParams(var Params: TCreateParams); override;
     procedure WMEraseBkgnd(var Msg: TWMEraseBkgnd); message WM_ERASEBKGND;
     procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState);
       override;
   public
     { Public declarations }
     constructor Create(AOwner: TComponent); override;
     procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
   published
     { Published declarations }
     property Style default lbOwnerDrawFixed;
     property Ctl3D default False;
     property BorderStyle default bsNone;
   end;



 constructor TListBox.Create(AOwner: TComponent);
begin
   inherited Create(AOwner);
   Ctl3D       := False;
   BorderStyle := bsNone;
   Style       := lbOwnerDrawFixed;
end;

procedure TListBox.CreateParams(var Params: TCreateParams);
begin
   inherited CreateParams(Params);
   Params.ExStyle := Params.ExStyle or WS_EX_TRANSPARENT;
end;

procedure TListBox.WMEraseBkgnd(var Msg: TWMEraseBkgnd);
begin
   Msg.Result := 1;    
end;

procedure TListBox.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
var
   tlbVisible: Boolean;
begin
   tlbVisible := (Parent <> nil) and IsWindowVisible(Handle);  
   if tlbVisible then ShowWindow(Handle, SW_HIDE);             
   inherited SetBounds(ALeft, ATop, AWidth, AHeight);        
   if tlbVisible then ShowWindow(Handle, SW_SHOW);           

end;

procedure TListBox.DrawItem(Index: Integer; Rect: TRect;
   State: TOwnerDrawState);
var
   FoundStyle: TBrushStyle;
   R: TRect;
begin
   FoundStyle := Canvas.Brush.Style;   
   R := Rect;     
   MapWindowPoints(Handle, Parent.Handle, R, 2);  
   InvalidateRect(Parent.Handle, @R, True);  
   item Position
   Parent.Update;    
   if not (odSelected in State) then
   begin  
     Canvas.Brush.Style := bsClear;  
   end
   else
   begin
     Canvas.Brush.Style := bsSolid;
   end;
   inherited DrawItem(Index, Rect, State);
   Canvas.Brush.Style := FoundStyle;
end;

И у меня есть мой DrawItem: 

procedure TMainForm.MenuDrawItem(Control: TWinControl; Index: integer;
  Rect: TRect; State: TOwnerDrawState);
var
  Sender: TListBox;
  R: TRect;
begin
  Sender := (Control as TListBox);
  if (odSelected in State) then
  begin
    Sender.Canvas.Font.Color := clWhite;
    Sender.Canvas.Font.Style := [fsBold];
    GradientFillCanvas(Sender.Canvas, $00C08000, $00FF8000, Rect, gdVertical);
  end
  else
  begin
    Sender.Canvas.Brush.Style := bsClear;
    Sender.Canvas.Font.Color := clblack;
  end;
  R := Rect;
  Sender.Canvas.Brush.Style := bsClear;

  MainMenuImageList.Draw(Sender.Canvas, 3, R.top + (R.Bottom - R.top - 48)
    div 2, Index, True);
  R.left := MainMenuImageList.width + 10;

  DrawText(Sender.Canvas.Handle, Sender.Items[Index],
    Length(Sender.Items[Index]), R, DT_SINGLELINE or DT_LEFT or DT_VCENTER or
    DT_END_ELLIPSIS);

  if odFocused in State then
    DrawFocusRect((Control as TListBox).Canvas.Handle, Rect);
end;

Проблема в том, что ListBox не работает должным образом, элементы исчезают, мигают ...

Я не могу объединить код из 2 процедур и оставить только одну (переопределенную или мою): 

procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override;

OR 

TMainForm.MenuDrawItem(Control: TWinControl; Index: integer; Rect: TRect; State: TOwnerDrawState);

Как сделать так, чтобы все работало нормально, поле со списком прозрачно, элементы прорисованы правильно?

1 Ответ

0 голосов
/ 31 декабря 2011

Я не верю, что вы можете создать прозрачный список, если этот стиль явно не поддерживается общими элементами управления Windows.Наличие предмета, нарисованного владельцем, может позволить вам «не перерисовывать элементы», но это не так, как вы сказали «отлично работает».Предметы исчезают и мигают, потому что вы не красите их полностью.

Краткий ответ: Нет, вы не можете.Оригинальная ссылка претендует на работу.Можете ли вы подробно описать проблему, которую вы обнаружили с исходным кодом, и, возможно, кто-то может предложить обходной путь?

...