Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Основная";
Текущий архив: 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.048 c
15-1147190703
asd
2006-05-09 20:05
2006.06.04
Ошибка [Error] Unit1.pas(40): Undeclared identifier: Connected


15-1146987805
Nic
2006-05-07 11:43
2006.06.04
Никто не программировал MathCad?


2-1146828997
JorSand
2006-05-05 15:36
2006.06.04
НОВОЕ в MDI


15-1147460680
i-s-v
2006-05-12 23:04
2006.06.04
Не подскажите, как установить РНР как приложение CGI?


3-1144923811
Dust
2006-04-13 14:23
2006.06.04
Кол-во уникальных записей в таблице MS Access





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский