| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

ListBox с рамкой [D7, WinXP]

Leonardo ©   (2006-04-26 14:52:00) 

Как вокруг 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-05-01 00:05:00) [1]

Подскажите кто-нибудь пожалуйста...=(

---

Leonardo   (2006-04-28 00:38:00) [2]

Нашел в интернете книгу Фленова "Библия Delphi", скачал... Там есть рисование на ListBox-е но там только строки и все... а мне бордюр же надо рисовать...

---

Leonardo   (2006-04-27 19:47:00) [3]

TStas, пришли пожалуйста код... у меня нету этой книги =((

---

TStas   (2006-04-27 19:33:00) [4]

У Фленова есть рисование на листбоксе, я в точности по нему делал - все отлично работает

---

Leonardo   (2006-04-27 18:16:00) [5]

Попробовал так обрабатывать, что-то не рисуется =(

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) где нет строк фона вообще нету, прозрачное все получается, показывается то что за окном... Мастера, подскажите пожалуйста

---

Gero   (2006-04-26 23:02:00) [6]

WM_NCPAINT

---

Leonardo   (2006-04-26 22:19:00) [7]

Видимо подругому никак...=(

---

Наверх