Создание прозрачного TListBox в Delphi
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;
ИЛИ ЖЕ
TMainForm.MenuDrawItem(Control: TWinControl; Index: integer; Rect: TRect; State: TOwnerDrawState);
Как сделать, чтобы все работало нормально, поле со списком прозрачно, элементы нарисованы правильно?
1 ответ
Я не верю, что вы можете создать прозрачный список, если этот стиль явно не поддерживается общими элементами управления Windows. Наличие элемента, нарисованного владельцем, может позволить вам "не перерисовывать элементы", но это не так, как вы сказали "отлично работает". Предметы исчезают и мигают, потому что вы не красите их полностью.
Краткий ответ: нет, вы не можете. Оригинальная ссылка претендует на работу. Можете ли вы подробно описать проблему, которую вы обнаружили с исходным кодом, и, возможно, кто-то может предложить обходной путь?