Очистка canvas DrawGrid

Вопросы программирования и использования среды Lazarus.

Модератор: Модераторы

Ответить
dvpt
новенький
Сообщения: 38
Зарегистрирован: 18.03.2009 10:46:04

Очистка canvas DrawGrid

Сообщение dvpt »

Не понятная ситуация.
Полность перенес отрисовку DrawGrid из Delhi.
Очищает все поле прорисовки только один раз при открытии DrawGrid.
После категорически отказывается.
Видимо какая то недоработка в Lazarus или я что то непонимаю?
haword
постоялец
Сообщения: 301
Зарегистрирован: 02.03.2006 10:34:40

Сообщение haword »

проверяй системный вызов LM_PAINT
dvpt
новенький
Сообщения: 38
Зарегистрирован: 18.03.2009 10:46:04

Сообщение dvpt »

можно уточнить, где его "системный вызов LM_PAINT" проверить?
По хелпу и исходникам не понял что это, И почему без него все работает в Delphi?
haword
постоялец
Сообщения: 301
Зарегистрирован: 02.03.2006 10:34:40

Сообщение haword »

в винде называется WM_PAINT, это системное сообщение посылается окну когда надо его перерисовать. В лазаре оно называется LM_PAINT. Обычно компоненты которые саим рисуют что либо, перекрывают его. Ты скорее всего неправильно портировал что ни будь и убрал этот вызов. Поставь точку останова на него и смотри. И еще напрямую переносить код непозваляет тебе твое лицензионное соглашение с борландом :)
dvpt
новенький
Сообщения: 38
Зарегистрирован: 18.03.2009 10:46:04

Сообщение dvpt »

Как ни странно все хорошо работает в Lazarus под Linux`сом :roll:
dvpt
новенький
Сообщения: 38
Зарегистрирован: 18.03.2009 10:46:04

Сообщение dvpt »

Вставил пред открытим Grida такой код:
IntersectClipRect(PictGrid1.Canvas.Handle, PictGrid1.Left, PictGrid1.Top, PictGrid1.Left + PictGrid1.Width, PictGrid1.Top + Height);
PictGrid1.Perform(LM_PAINT, PictGrid1.Canvas.Handle, 0);
Application.ProcessMessages;

Помогло, но нен до конца :cry:

Добавлено спустя 1 час 10 минут 14 секунд:
Может что еще надо сделать?
haword
постоялец
Сообщения: 301
Зарегистрирован: 02.03.2006 10:34:40

Сообщение haword »

странный ты человек. мы ж не знаем что ты там намутил не видя полностью твоего кода? Всеранво что я тебе щас скажу - у меня есть программа, она передает данные через интернет, но почему то не работает, не подскажешь почему? :)
Чтобы понять почему не работает или по чему работает в линуксе, ставишь точки останова на функции прорисовки и смотришь почему куда надо программа не попадает.
dvpt
новенький
Сообщения: 38
Зарегистрирован: 18.03.2009 10:46:04

Сообщение dvpt »

Согласен конечно :) Буду разбираться.
dvpt
новенький
Сообщения: 38
Зарегистрирован: 18.03.2009 10:46:04

Сообщение dvpt »

Код довольно простой, выводит список файлов

procedure TForm1.KinoGrid1DrawCell(Sender: TObject; aCol, aRow: Integer;
aRect: TRect; aState: TGridDrawState);
var
h, c: Integer;
i, ii: Integer;
s, ss : String;
a : String;
begin
if VideoLst = NIL then exit;
if VideoLst.Count = 0 then exit;
i := KinoGrid1.ColCount * ARow + ACol;// Пересчитываем координаты ячейки в индекс списка:
with KinoGrid1.Canvas, VideoLst do begin
if (gdFocused in aState) then
if i < VideoLst.Count then iVideo := i;// запоминаю текущую строку
CopyMode := cmSrcCopy;
Brush.Style := bsClear;
Brush.Color := clWhite;
FillRect( ARect);
CopyRect( ARect, Image4.Canvas, Image4.Canvas.ClipRect);
if i < VideoLst.Count then begin
ii := Pos(':',VideoLst[i]);// разбираем имя файла
if ii > 0 then begin
s := Copy(VideoLst[i],1,ii-1);
ss := Copy(VideoLst[i],ii+1,255);
end else begin
s := VideoLst[i];
ss := '';
end;
CopyMode := cmSrcAnd;
Font.Name := Family.Font.Name;
Font.Name := Family.Font.Name;
//рисую имя файла
Font.Color := clGreen;
Font.Style := [fsBold];
c := TextWidth('W');//ширина одного символа
h := TextHeight('W');//высота одного символа
ii := 1;
a := '';
for i := 1 to Length(s) do begin
a := a + Copy(s,i,1);
if (((TextWidth(a)+c) >= (ARect.Bottom - ARect.Top)) or (i = Length(s))) then begin
TextRect( ARect, ARect.Left+4, ARect.Top+(ii-1)*h, a);
a := '';
Inc(ii);
if (ii > (((ARect.Bottom - ARect.Top) div 2) div h)) then break;//max колич. строк
end;
end;
//рисую пояснения к файлу
Font.Color := clBlue;
Font.Style := [fsBold,fsItalic];
c := TextWidth('W');//ширина одного символа
h := TextHeight('W');//высота одного символа
a := '';
for i := 1 to Length(ss) do begin
a := a + Copy(ss,i,1);
if (((TextWidth(a)+c) >= (ARect.Bottom - ARect.Top)) or (i = Length(ss))) then begin
TextRect( ARect, ARect.Left+4, ARect.Top+(ii-1)*h, a);
a := '';
Inc(ii);
if (ii > (((ARect.Bottom - ARect.Top) div 2) div h)) then break;//max колич. строк
end;
end;
end;
end;
end;
dvpt
новенький
Сообщения: 38
Зарегистрирован: 18.03.2009 10:46:04

Сообщение dvpt »

Версия 2.2.4rc1 сильно помогла :-)
2.2.5 пока не пробовал, думаю она еще лучше.
DrawGrid заработал правильно.
Ответить