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

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

Своя отрисовка TMemo

Alex_C ©   (2014-03-14 11:25:00) 

Столкнулся с такой проблемой:
нужно создать свой TMemo с подсветкой синтаксиса.
Вроде как не проблема. Делаю так:


 TMyMemo = class(TCustomMemo)
 ...
   procedure WMPaint(var message: TWMPaint); message WM_PAINT;

var
 FImage: TBitMap;

procedure TMyMemo.WMPaint(var Message: TWMPaint);

begin
 DC := Message.DC;
 if DC = 0 then
   DC := BeginPaint(Handle, PS);
 try
   FImage.Handle := CreateCompatibleBitmap(DC, Width, Height);
   тут рисую на FImage то что надо

   BitBlt(DC, 0, 0, FImage.Width, FImage.Height, FImage.Canvas.Handle,
     0, 0, SRCCOPY);
 finally
   if Message.DC = 0 then
     EndPaint(Handle, PS);
 end;
end;


Однако при постоянной отрисовке своего мемо заметил мерцание, которого при BitBlt быть не должно. При пошаговой трассировке выяснилось, что мое мемо сначала отрисовывается как стандартное мемо, а вот потом происходит отрисовка по моему событию.
Вопрос: в каком месте происходит эта стандартная отрисовка и как ее отменить.

---

Alex_C   (2014-03-21 17:59:00) [1]

Как выяснилось, что написал Юрий Зотов - правда)))
Нужно


procedure TMyMemo.CNCommand(var Message: TWMCommand);
begin
 if (Message.NotifyCode = EN_CHANGE) then
   // Для перерисовки при изменении текста
 begin
   if Assigned(FOnChange) then FOnChange(Self);
   //inherited; //<- не вызываем, рисуем сами!
   Refresh;
 end;
end;


обрабатывать самому EN_CHANGE.

Теперь следующая проблема: TWMHScroll


procedure TMyMemo.WMHScroll(var Message: TWMHScroll);
var
 Position, HMin, HMax: integer;
 SI: TScrollInfo;
 CaretP: integer;
begin
//  inherited;
 CaretP := GetCaretPosFromXY(CaretPos);
 GetScrollRange(Handle, SB_HORZ, HMin, HMax);
 Position := GetScrollPos(Handle, SB_HORZ);
 with Message do
   case ScrollCode of
     SB_LINELEFT: SetScrollPos(Handle, SB_HORZ, Position - 1, True);
     SB_LINERIGHT: SetScrollPos(Handle, SB_HORZ, Position + 1, True);
     SB_PAGELEFT: SetScrollPos(Handle, SB_HORZ, Position - 10, True);
     SB_PAGERIGHT: SetScrollPos(Handle, SB_HORZ, Position + 10, True);
     SB_THUMBPOSITION, SB_THUMBTRACK:
       begin
         SI.cbSize := sizeof(SI);
         SI.fMask := SIF_ALL;
         GetScrollInfo(Handle, SB_HORZ, SI);
         SetScrollPos(Handle, SB_HORZ, SI.nTrackPos, True);
       end;
     SB_RIGHT: SetScrollPos(Handle, SB_HORZ, HMax, True);
     SB_LEFT: SetScrollPos(Handle, SB_HORZ, HMin, True);
   end;
 CaretPos := GetXYFromPosn(CaretP);
 Refresh;
end;


Работать то работает, да вот проблема с позицией курсора - не соответствует она действительности - т.е. не учитывается ширина букв, которая разная для каждой буквы. Понятно что нужно как бы самому рассчитывать ширину букв. Только как сделать - пока идей нет.

---

Юрий Зотов   (2014-03-14 13:20:00) [2]

Удалено модератором
Примечание: Дубль

---

Юрий Зотов   (2014-03-14 13:19:00) [3]

> Alex_C   (14.03.14 12:41) [6]
> почему без них вызывается не мой метод Paint, а стандартный виндовый?

Надо смотреть, что происходит внутри EndUpdate. Возможно, вместо посылки WM_PAINT там идет принудительная отрисовка, поэтому до Вашего перехватчика дело не доходит. И если так, то этим кодом мы просто свели многократную стандартную отрисовку к однократной, вот оно и не моргает.

---

Alex_C   (2014-03-14 12:41:00) [4]

BeginUpdate/EndUpdate - да дело действительно в этом. Но почему без них вызывается не мой метод Paint, а стандартный виндовый?

---

Юрий Зотов   (2014-03-14 12:17:00) [5]

Не в BeginUpdate ли тут дело?

with MyMemo.Lines do
begin
 BeginUpdate;
 try
   while Count >= 50 do      
     Delete(0);
 finally
   EndUpdate
 end
end;

---

Игорь Шевченко   (2014-03-14 12:12:00) [6]

еще как минимум WM_CTLCOLOREDIT (CN_CTLCOLOREDIT)

---

Alex_C   (2014-03-14 12:11:00) [7]

В дополнение к этому: я нашел в какой момент идет стандартная отрисовка:

У меня есть такой код

   while MyMemo.Lines.Count >= 50 do      
     MyMemo.Lines.Delete(0);                    <- вот тут идет стандартная отрисовка
   MyMemo.Text := MyMemo.Text + TextOut;
   MyMemo.SelStart := Length(MyMemo.Text);


---

Alex_C   (2014-03-14 11:56:00) [8]

Да про SynEdit знаю, но мне своя специфика нужна.
На счет WM_ERASEBKGND - это есть


procedure TMyMemo.WMEraseBkgnd(var Msg: TMessage);
begin
 Msg.Result := 1;
end;


Но все равно есть мерцание - т.е. винда все равно сама рисует фон.

---

clickmaker   (2014-03-14 11:35:00) [9]

а принципиально мемо? есть ведь SynEdit с пачкой готовых подсветчиков.
Если по теме - то вроде как надо в WM_ERASEBKGND возвращать не ноль, говоря винде, что ты сам рисуешь фон

---

Наверх