Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Компоненты Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 24.10.2014, 17:06   #1
NEoMASTERR
Форумчанин
 
Аватар для NEoMASTERR
 
Регистрация: 22.12.2010
Сообщений: 175
По умолчанию Canvas мерцает

Здравствуйте, решил сделать свой визуальный компонент (пока для теста, чтобы понять основы) и попал в ступор, канва при wmPaint мерцает, DoubleBuffered:=true не предлагать, нужен другой подход, помогите пжл)
Рисую в битмапе невизуально - всё равно мерцает, я уже иссяк.
Мерцает при WMMouseMove и зажатой лкм (тащу за границы вверх - вниз)
Могу скинуть полный исходник

Код:
  TNEoBar = class(TGraphicControl)
  private
    fonmouseenter,fonmouseleave:tnotifyevent;
    FMaxX,FMinX,FPosition,fmaxOld: Integer;
    FDrawMetrics: boolean;
    PDebu: FDebu;
    FCanDrag :Boolean;
    //b:TBitmap;
  { private declarations }
  protected
  procedure wmlbuttondown(var message:twmmouse);message wm_lbuttondown;
  procedure wmldblclick(var message:TWMMouse);message WM_LBUTTONDBLCLK;
  procedure wmlbuttonup(var message:twmmouse);message wm_lbuttonup;
  procedure wmmousemove(var message:twmmousemove);message wm_mousemove;
  procedure cmmouseenter(var message:tmessage);message cm_mouseenter;
  procedure cmmouseleave(var message:tmessage);message cm_mouseleave;
  procedure wmEraseBkGnd(var Msg: TWMEraseBkGnd); message WM_ERASEBKGND;
  public
  constructor create(aowner:tcomponent);override;
  destructor destory;virtual;
  procedure repaint;override;
  procedure paint;override;
Код:
procedure TNEoBar.paint;
var
  x,i,xx:integer;
  b:TBitmap;
begin
  inherited;
  b:=TBitmap.Create;

  b.Width:=Width;
  b.Height:=Height;

  x:=height - (height * FPosition div FMaxX);		// Вычисляем процентное соотношение высоты к FMaxX

  b.canvas.Brush.Style:=bsClear;
  b.canvas.Pen.Style:=psDash;
  b.canvas.Pen.color:=clBlack; 

  b.canvas.Rectangle(0,0,Width,Height);  // Рисуем границы компонента 

  b.canvas.Pen.Style:=psSolid;
  b.canvas.Pen.Color:=RGB(255,0,255);

  if FDrawMetrics then				// if true then Рисуем деления шкалы
  begin
    for i:=0 to x do
    begin
      if FCanDrag then xx:=fmaxOld else xx:=FMaxX;
      if i mod (height div xx) = 0 then
      begin
        b.canvas.MoveTo(0,i);
        b.canvas.LineTo(15,i);
      end;
    end;
  end;

  b.canvas.Brush.Style:=bsSolid;
  b.canvas.Brush.Color:=clGreen;
  b.canvas.Rectangle(0,x,Width,Height);                   //Рисуем прогрессбар

  Canvas.Draw(0,0,b);

  b.free;
  //debu(inttostr(FPosition));
end;
Код:
procedure TNEoBar.wmlbuttondown(var message: twmmouse);
var
  x:integer;
begin
  if ptinrect(ClientRect,smallpointtopoint(message.pos)) then
  begin
    x:=message.YPos - (height - (height * FPosition div FMaxX));
    FCanDrag :=  (x <= 10) and (x>=-1);
    if FCanDrag then
    begin
      Cursor:=crHandPoint;
      fmaxOld:=fmaxx;
      fmaxx:=Height;
    end;
  end;
end;

procedure TNEoBar.wmlbuttonup(var message: twmmouse);
begin
  Cursor:=crDefault;
  fmaxx:=fmaxOld;

  if FCanDrag then
  begin
    FPosition:=(Height - message.YPos) * FMaxX div Height;
  end
  else
  begin
    FPosition:=(Height - message.YPos) * fmaxOld div Height;
    FCanDrag:=False;
  end;
  repaint;
end;

procedure TNEoBar.wmmousemove(var message: twmmousemove);
var
  x:integer;
begin
  if ptinrect(ClientRect,smallpointtopoint(message.pos)) then
  begin
    x:=message.YPos - (height - (height * FPosition div FMaxX));
    if (x <= 10) and (x>=-1) then Cursor:=crHandPoint else Cursor:=crDefault;

    if FCanDrag then
    begin
      if csLButtonDown in ControlState then
      begin
        Cursor:=crHandPoint;
        x:=height - (height * FPosition div FMaxX);

        //Debu(Format('(%d - %d) * %d div %d',[Height,message.YPos,FMaxX,Height]));

        FPosition:=(Height - message.YPos) * FMaxX div Height;

        repaint;
      end;
    end;
  end;
  //message.Result:=1;
end;
Здравствуйте

Последний раз редактировалось NEoMASTERR; 24.10.2014 в 17:09.
NEoMASTERR вне форума Ответить с цитированием
Старый 24.10.2014, 22:42   #2
min@y™
Цифровой кот
Старожил
 
Аватар для min@y™
 
Регистрация: 29.08.2014
Сообщений: 7,656
По умолчанию

ну, для начала я бы выкинул создание битмапа из paint.
Цитата:
DoubleBuffered:=true не предлагать
Почему? Я имею в виду DoubleBuffered оконного элемента, который Parent твоего TNEoBar.
Расскажу я вам, дружочки, как выращивать грибочки: нужно в поле утром рано сдвинуть два куска урана...

Последний раз редактировалось min@y™; 24.10.2014 в 22:45.
min@y™ вне форума Ответить с цитированием
Старый 24.10.2014, 23:21   #3
NEoMASTERR
Форумчанин
 
Аватар для NEoMASTERR
 
Регистрация: 22.12.2010
Сообщений: 175
По умолчанию

Цитата:
Сообщение от min@y™ Посмотреть сообщение
ну, для начала я бы выкинул создание битмапа из paint.

Почему? Я имею в виду DoubleBuffered оконного элемента, который Parent твоего TNEoBar.
Битмап перенесу, я в курсе нагрузки, буфферизация на форме вызывает странный эффект на кнопках, которые тоже лежат на форме, поэтому я не хочу её
Здравствуйте
NEoMASTERR вне форума Ответить с цитированием
Старый 24.10.2014, 23:24   #4
min@y™
Цифровой кот
Старожил
 
Аватар для min@y™
 
Регистрация: 29.08.2014
Сообщений: 7,656
По умолчанию

Цитата:
буфферизация на форме вызывает странный эффект на кнопках, которые тоже лежат на форме, поэтому я не хочу её
а и не надо, положь на panel и включи даблбуфферед тольо у этой панели.
Расскажу я вам, дружочки, как выращивать грибочки: нужно в поле утром рано сдвинуть два куска урана...
min@y™ вне форума Ответить с цитированием
Старый 25.10.2014, 00:15   #5
NEoMASTERR
Форумчанин
 
Аватар для NEoMASTERR
 
Регистрация: 22.12.2010
Сообщений: 175
По умолчанию

Цитата:
Сообщение от min@y™ Посмотреть сообщение
а и не надо, положь на panel и включи даблбуфферед тольо у этой панели.
Дело в том что я пишу отдельный компонент, зачем мне лишние панельки под него подкладывать?)
Здравствуйте
NEoMASTERR вне форума Ответить с цитированием
Старый 25.10.2014, 00:28   #6
min@y™
Цифровой кот
Старожил
 
Аватар для min@y™
 
Регистрация: 29.08.2014
Сообщений: 7,656
По умолчанию

Цитата:
зачем мне лишние панельки под него подкладывать?
ты ж хотел, шоб не моргало. перехотел?
ну как знаешь. пойду спать.
Расскажу я вам, дружочки, как выращивать грибочки: нужно в поле утром рано сдвинуть два куска урана...
min@y™ вне форума Ответить с цитированием
Старый 25.10.2014, 00:52   #7
NEoMASTERR
Форумчанин
 
Аватар для NEoMASTERR
 
Регистрация: 22.12.2010
Сообщений: 175
По умолчанию

Цитата:
Сообщение от min@y™ Посмотреть сообщение
ты ж хотел, шоб не моргало. перехотел?
ну как знаешь. пойду спать.
Я хотел без извращений
Здравствуйте
NEoMASTERR вне форума Ответить с цитированием
Старый 25.10.2014, 11:00   #8
min@y™
Цифровой кот
Старожил
 
Аватар для min@y™
 
Регистрация: 29.08.2014
Сообщений: 7,656
По умолчанию

Цитата:
Я хотел без извращений
поэтому не думал, что мерцать может именно оконный элемент под твоим графическим.
Расскажу я вам, дружочки, как выращивать грибочки: нужно в поле утром рано сдвинуть два куска урана...
min@y™ вне форума Ответить с цитированием
Старый 25.10.2014, 11:53   #9
NEoMASTERR
Форумчанин
 
Аватар для NEoMASTERR
 
Регистрация: 22.12.2010
Сообщений: 175
По умолчанию

Цитата:
Сообщение от min@y™ Посмотреть сообщение
поэтому не думал, что мерцать может именно оконный элемент под твоим графическим.
Думал, но не знаю как объявить parent as TForm без добавления Forms в Uses, я сюда за помощью и пришёл)
Здравствуйте
NEoMASTERR вне форума Ответить с цитированием
Старый 25.10.2014, 12:04   #10
min@y™
Цифровой кот
Старожил
 
Аватар для min@y™
 
Регистрация: 29.08.2014
Сообщений: 7,656
По умолчанию

Цитата:
не знаю как объявить parent as TForm
а это зачем?
Расскажу я вам, дружочки, как выращивать грибочки: нужно в поле утром рано сдвинуть два куска урана...
min@y™ вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Мерцает GIF анимация bilibian Общие вопросы Delphi 2 26.09.2014 14:06
Drawer Panel мерцает Ko$ Общие вопросы Delphi 2 19.10.2011 13:53
Word 2003 мерцает RIO Софт 0 27.09.2010 16:55
Мерцает экран Ned23 Компьютерное железо 3 13.11.2009 19:59
и все равно мерцает! Spiritual Win Api 4 06.02.2009 20:28