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

Вниз

Своя отрисовка TMemo   Найти похожие ветки 

← →
Alex_C   (2014-03-14 11:25) [0]

Столкнулся с такой проблемой:
нужно создать свой 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 быть не должно. При пошаговой трассировке выяснилось, что мое мемо сначала отрисовывается как стандартное мемо, а вот потом происходит отрисовка по моему событию.
Вопрос: в каком месте происходит эта стандартная отрисовка и как ее отменить.

---

← →
clickmaker ©   (2014-03-14 11:35) [1]

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

---

← →
Alex_C   (2014-03-14 11:56) [2]

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


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


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

---

← →
Alex_C   (2014-03-14 12:11) [3]

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

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

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


---

← →
Игорь Шевченко ©   (2014-03-14 12:12) [4]

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

---

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

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

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

---

← →
Alex_C   (2014-03-14 12:41) [6]

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

---

← →
Юрий Зотов ©   (2014-03-14 13:19) [7]

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

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

---

← →
Юрий Зотов ©   (2014-03-14 13:20) [8]

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

---

← →
Alex_C   (2014-03-21 17:59) [9]

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


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;


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

---

Страницы: 1 вся ветка

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

Наверх

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