Текущий архив: 2006.06.04;
Скачать: CL | DM;

Вниз

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;
Скачать: CL | DM;

Наверх

Память: 0.49 MB
Время: 0.049 c