Форум: "Основная";
Текущий архив: 2006.06.04;
Скачать: [xml.tar.bz2];
Вниз
ListBox с рамкой Найти похожие ветки
← →
Leonardo (2006-04-26 14:52) [0]Как вокруг ListBox-а рисовать свою рамку? Если рисовать ее в WM_PAINT или в WM_ERASEBKGND то она затирается при выборе строк, т.к. если выбрать какуюнибудь строчку, а потом еще какуюнибудь другую, то по бокам той которая была выбрана стирается эта рамка... Приходится рисовать рамку в CN_DRAWITEM, но мне кажется это не правильно... Может есть способ лучше? Подскажите...
type
TMyListBox = class(TListBox)
private
FShowBorder: Boolean;
FBorderColor: TColor;
procedure SetShowBorder(Value: Boolean);
procedure SetBorderColor(Value: TColor);
procedure CNDrawItem(var Message: TWMDrawItem); Message CN_DRAWITEM;
procedure WMEraseBkgnd(var Message: TWMERASEBKGND); Message WM_ERASEBKGND;
protected
procedure CreateParams(var Params: TCreateParams); override;
public
constructor Create(AOwner: TComponent); override;
published
property ShowBorder: Boolean read FShowBorder write SetShowBorder default true;
property BorderColor: TColor read FBorderColor write SetBorderColor;
end;
constructor TMyListBox.Create(AOwner: TComponent);
begin
inherited;
BorderStyle := bsNone;
end;
procedure TMyListBox.SetShowBorder(Value: Boolean);
begin
if FShowBorder <> Value then
begin
FShowBorder := Value;
Invalidate;
end;
end;
procedure TMyListBox.SetBorderColor(Value: TColor);
begin
if FBorderColor <> Value then
begin
FBorderColor := Value;
Invalidate;
end;
end;
procedure TMyListBox.CreateParams(var Params: TCreateParams);
begin
inherited;
with Params do
begin
if Style and (LBS_OWNERDRAWFIXED or LBS_OWNERDRAWVARIABLE) = 0 then
Style := Style or LBS_OWNERDRAWFIXED;
end;
end;
procedure TMyListBox.CNDrawItem(var Message: TWMDrawItem);
var
State: TOwnerDrawState;
begin
with Message.DrawItemStruct^ do
begin
State := TOwnerDrawState(LongRec(itemState).Lo);
Canvas.Handle := hDC;
Canvas.Font := Font;
Canvas.Brush := Brush;
if (Integer(itemID) >= 0) and (odSelected in State) then
begin
Canvas.Brush.Color := FSelectedColor;
Canvas.Font.Assign(FSelectedFont);
end;
Canvas.FillRect(rcItem);
Canvas.Brush.Style := bsClear;
if FShowBorder then
begin
Canvas.Pen.Color := FBorderColor;
Canvas.Rectangle(0, 0, Width, Height); Тут рисуем саму рамку
end;
if Integer(itemID) >= TopIndex then
DrawItem(itemID, rcItem, State);
Canvas.Handle := 0;
end;
end;
procedure TMyListBox.WMEraseBkgnd(var Message: TWMERASEBKGND);
begin
InvalidateRect(Handle, nil, false);
Message.Result := 1;
end;
← →
Leonardo (2006-04-26 22:19) [1]Видимо подругому никак...=(
← →
Gero © (2006-04-26 23:02) [2]WM_NCPAINT
← →
Leonardo (2006-04-27 18:16) [3]Попробовал так обрабатывать, что-то не рисуется =(
procedure TMyListBox.WMNCPaint(var Message: TWMNCPAINT);
begin
inherited;
if FShowBorder then
begin
Canvas.Brush.Style := bsClear;
Canvas.Pen.Color := FBorderColor;
Canvas.Rectangle(0, 0, Width, Height);
end;
end;
Приведу весь код компонента, я уже правда не знаю в чем проблема, просто я еще что заметил, при смене цвета фона(свойство Color), меняется фон только там где есть строки, а где пусто остается тот же цвет какой был, потом уже только если свернуть и развернуть окно рисуется... вобщем после перерисовки окна... И рамка так не рисуется...:
type
TMyListBox = class(TListBox)
private
FSelectedFont: TFont;
FSelectedColor: TColor;
FShowBorder: Boolean;
FBorderColor: TColor;
procedure SetShowBorder(Value: Boolean);
procedure SetBorderColor(Value: TColor);
procedure CNDrawItem(var Message: TWMDRAWITEM); Message CN_DRAWITEM;
procedure WMNCPaint(var Message: TWMNCPAINT); Message WM_NCPAINT;
protected
procedure CreateParams(var Params: TCreateParams); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property SelectedFont: TFont read FSelectedFont write FSelectedFont;
property SelectedColor: TColor read FSelectedColor write FSelectedColor;
property ShowBorder: Boolean read FShowBorder write SetShowBorder default true;
property BorderColor: TColor read FBorderColor write SetBorderColor;
end;
...
constructor TMyListBox.Create(AOwner: TComponent);
begin
inherited;
BorderStyle := bsNone;
FShowBorder := true;
FSelectedFont := TFont.Create;
FSelectedColor := clActiveCaption;
end;
destructor TMyListBox.Destroy;
begin
FSelectedFont.Free;
inherited;
end;
procedure TMyListBox.SetShowBorder(Value: Boolean);
begin
if FShowBorder <> Value then
begin
FShowBorder := Value;
Invalidate;
end;
end;
procedure TMyListBox.SetBorderColor(Value: TColor);
begin
if FBorderColor <> Value then
begin
FBorderColor := Value;
Invalidate;
end;
end;
procedure TMyListBox.CNDrawItem(var Message: TWMDRAWITEM);
var
State: TOwnerDrawState;
begin
with Message.DrawItemStruct^ do
begin
State := TOwnerDrawState(LongRec(itemState).Lo);
Canvas.Handle := hDC;
Canvas.Brush := Brush;
if (Integer(itemID) >= 0) and (odSelected in State) then
begin
Canvas.Brush.Color := FSelectedColor;
Canvas.Font := FSelectedFont;
end
else
Canvas.Font := Font;
Canvas.FillRect(rcItem);
Canvas.Brush.Style := bsClear;
if Integer(itemID) >= TopIndex then
DrawItem(itemID, rcItem, State);
Canvas.Handle := 0;
end;
end;
procedure TMyListBox.WMNCPaint(var Message: TWMNCPAINT);
begin
inherited;
if FShowBorder then
begin
Canvas.Brush.Style := bsClear;
Canvas.Pen.Color := FBorderColor;
Canvas.Rectangle(0, 0, Width, Height);
end;
end;
А при обработке WM_ERASEBKGND как показано в Leonardo (26.04.06 14:52) где нет строк фона вообще нету, прозрачное все получается, показывается то что за окном... Мастера, подскажите пожалуйста
← →
TStas © (2006-04-27 19:33) [4]У Фленова есть рисование на листбоксе, я в точности по нему делал - все отлично работает
← →
Leonardo (2006-04-27 19:47) [5]TStas, пришли пожалуйста код... у меня нету этой книги =((
← →
Leonardo (2006-04-28 00:38) [6]Нашел в интернете книгу Фленова "Библия Delphi", скачал... Там есть рисование на ListBox-е но там только строки и все... а мне бордюр же надо рисовать...
← →
Leonardo (2006-05-01 00:05) [7]Подскажите кто-нибудь пожалуйста...=(
Страницы: 1 вся ветка
Форум: "Основная";
Текущий архив: 2006.06.04;
Скачать: [xml.tar.bz2];
Память: 0.48 MB
Время: 0.05 c
