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

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

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

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 07.07.2011, 11:20   #1
vasily86
 
Регистрация: 17.02.2011
Сообщений: 3
По умолчанию Правильная перерисовка окна

Хочу понять как правильно перерисовывать окна, создал компонент - таблицу и через GDI отрисовал её, перехватив сообщение WM_PAINT. Теперь при щелчке хочу выделять нужную строку, вот тут и проблема, как правильно стереть предыдущее выделение и отрисовать текущее?
Код:
  TClass = class(TWinControl)
  private
    y: integer;             //координаты выделенной строки
  protected
    procedure WndProc(var Message: TMessage); override;
  end;
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }

  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  cl: TClass;
Код:
procedure TClass.WndProc(var Message: TMessage);
var
  ps: PAINTSTRUCT;
  dc: HDC;
  rect: TRect;
  a:    integer;
begin
  

  if (Message.Msg = WM_PAINT) then
    begin
      DC := BeginPaint(Handle, ps);
      GDIPaint(DC);
      EndPaint(Handle,ps);
      exit;
    end;

  if (Message.Msg = WM_LBUTTONDOWN) then
    begin

      //SetRect(rect, 11, a*20+2, 204, a*20+19);
      y := TWMMouse(Message).YPos;
      SetRect(rect, 0, 0, 500, 500);

      InvalidateRect(cl.Handle, @rect, true);
      exit;
    end;

  inherited;

end;
Код:
procedure GDIPaint(DC: HDC);
var
  Pen:    HPEN;
  i:      integer;

  Brush:    HBRUSH;
  rect:     TRect;
  a:        integer;
begin
  SetBkColor(DC, clWhite);
  Rectangle(DC, 10, 0, 410, 300);

  Pen := CreatePen(0, 1, clBlack);
  SelectObject(DC, Pen);
  //рисуем таблицу
  for i := 1 to 10 do
    begin
      MoveToEx(DC, 10, i*20, nil);
      LineTo(DC, 410, i*20);
    end;

  MoveToEx(DC, 205, 0, nil);
  LineTo(DC, 205, 200);

  SelectObject(DC, GetStockObject(NULL_PEN));
  DeleteObject(Pen);

  a := cl.y div 20;
  brush := GetStockObject(DC_BRUSH);
  SelectObject(DC, brush);
  SetDCBrushColor(DC, $FFD3BA);
  SetRect(rect, 11, a*20+1, 205, a*20+20);
  FillRect(DC, rect, brush);
  SetRect(rect, 206, a*20+1, 409, a*20+20);
  FillRect(DC, rect, brush);
  SelectObject(DC, GetStockObject(NULL_BRUSH));
  DeleteObject(brush);
end;

Даже если два раза напишу InvalidateRect со старым и новым значение, windows всё равно вызовет WM_PAINT один раз. Получается красиво, но делать перерисовку лишних данных думаю что всё таки неправильно.
Поскажите куда копать
Изображения
Тип файла: jpg test.JPG (18.5 Кб, 156 просмотров)
vasily86 вне форума Ответить с цитированием
Старый 07.07.2011, 12:38   #2
vasily86
 
Регистрация: 17.02.2011
Сообщений: 3
По умолчанию

мерцание прекратилось изменив одну строчку кода
Код:
  if (Message.Msg = WM_LBUTTONDOWN) then
    begin

      //SetRect(rect, 11, a*20+2, 204, a*20+19);
      y := TWMMouse(Message).YPos;
      SetRect(rect, 0, 0, 500, 500);

      InvalidateRect(cl.Handle, @rect, false);
      exit;
тупо не вызываем очистку
vasily86 вне форума Ответить с цитированием
Старый 07.07.2011, 14:36   #3
vasily86
 
Регистрация: 17.02.2011
Сообщений: 3
По умолчанию

Вообщем вроде как разобрался, смысл такой, посылаем два раза InvalidateRgn() со старыми координатами (которое очищает фон) и новое (рисует фон). Винда где-то в памяти помечает что данные координаты устарели и делает перерисовку только дня них, остальное не трогает, так что мерцания замечено не было, может код и не идеален. Кто знает точное решения данных проблем с радостью приму
Добавил ещё выделение строки при перемещении мыши
Код примера:
Код:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Grids, ExtCtrls;

type
  TClass = class(TWinControl)
  private
    FKol_vo:  integer;        //кол-во строк
    y:  integer;              //координаты выделенной строки
    y1: integer;              //координаты выделения при перемещении мышки
  protected
    procedure WndProc(var Message: TMessage); override;
  end;
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }

  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  cl: TClass;
implementation

{$R *.dfm}

{ TClass }

procedure GDIPaint(DC: HDC);
var
  Pen:    HPEN;
  i:      integer;

  Brush:    HBRUSH;
//  i:      integer;
  rect:     TRect;
  a:        integer;
begin
  SetBkColor(DC, clWhite);
  Rectangle(DC, 0, 0, cl.Width, cl.Height);

  Pen := CreatePen(0, 1, clBlack);
  SelectObject(DC, Pen);
  //рисуем таблицу
  for i := 1 to cl.FKol_vo do
    begin
      MoveToEx(DC, 0, i*20, nil);
      LineTo(DC, cl.Width, i*20);
    end;

  MoveToEx(DC, cl.Width div 2, 0, nil);
  LineTo(DC, cl.Width div 2, cl.FKol_vo*20);

  SelectObject(DC, GetStockObject(NULL_PEN));
  DeleteObject(Pen);

  a := cl.y div 20;
  if (a > cl.FKol_vo-1) then
    a := cl.FKol_vo-1;
  brush := GetStockObject(DC_BRUSH);
  SelectObject(DC, brush);
  SetDCBrushColor(DC, $FFD3BA);
  SetRect(rect, 1, a*20+1, cl.Width div 2, a*20+20);
  FillRect(DC, rect, brush);
  SetRect(rect, (cl.Width div 2)+1, a*20+1, cl.Width - 1, a*20+20);
  FillRect(DC, rect, brush);
  SelectObject(DC, GetStockObject(NULL_BRUSH));
  DeleteObject(brush);


  //


  if cl.y1 < 0 then     //если отрицательное - не рисуем
    exit;
  if (cl.y div 20) = (cl.y1 div 20) then //если совпадают - не рисуем
    exit;

  a := cl.y1 div 20;
  if (a > cl.FKol_vo-1) then
    a := cl.FKol_vo-1;
  brush := GetStockObject(DC_BRUSH);
  SelectObject(DC, brush);
  SetDCBrushColor(DC, $DBFFE9);
  SetRect(rect, 1, a*20+1, cl.Width div 2, a*20+20);
  FillRect(DC, rect, brush);
  SetRect(rect, (cl.Width div 2)+1, a*20+1, cl.Width - 1, a*20+20);
  FillRect(DC, rect, brush);
  SelectObject(DC, GetStockObject(NULL_BRUSH));
  DeleteObject(brush);
end;

procedure TClass.WndProc(var Message: TMessage);
var
  ps: PAINTSTRUCT;
  dc: HDC;
  rect: TRect;
  a:    integer;
  reg1, reg2, reg3:   HRGN;
begin
  

  if (Message.Msg = WM_PAINT) then
    begin
      DC := BeginPaint(Handle, ps);
      GDIPaint(DC);
      EndPaint(Handle,ps);
      exit;
    end;

  if (Message.Msg = WM_LBUTTONDOWN) then
    begin
      a := cl.y div 20;
      reg1 := CreateRectRgn(1, a*20+1, cl.Width, a*20+20);

      y := TWMMouse(Message).YPos;
      a := TWMMouse(Message).YPos div 20;
      reg2 := CreateRectRgn(1, a*20+1, cl.Width, a*20+20);

      InvalidateRgn(cl.Handle, reg1, false);
      InvalidateRgn(cl.Handle, reg2, false);
      exit;
    end;
  if (Message.Msg = WM_MOUSEMOVE) then
    begin
      //совпадает текущая строка с выделенной?
      if (cl.y1 div 20) = (TWMMouse(Message).YPos div 20) then
        begin
          //меняем позицию
          cl.y1 := TWMMouse(Message).YPos;
        end
      else
        //не равны
        begin
          //восстанавливаем старое значение
          a := cl.y1 div 20;
          reg1 := CreateRectRgn(1, a*20+1, cl.Width, a*20+20);

          //обновляем новое
          cl.y1 := TWMMouse(Message).YPos;
          a := cl.y1 div 20;
          reg2:= CreateRectRgn(1, a*20+1, cl.Width, a*20+20);
          
          InvalidateRgn(cl.Handle, reg1, false);
          InvalidateRgn(cl.Handle, reg2, false);
        end;
    end;
  if (Message.Msg = WM_MOUSELEAVE) then
    begin
      //очищаем
      a := cl.y1 div 20;
      if (a > cl.FKol_vo-1) then
        a := cl.FKol_vo-1;
      reg1 := CreateRectRgn(1, a*20+1, cl.Width, a*20+20);
      cl.y1 := -1;
      InvalidateRgn(cl.Handle, reg1, false);
      exit;
    end;

  inherited;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  cl := TClass.Create(Form1);
  cl.Left := 10;
  cl.Top := 10;
  //cl.Width := 800;
  //cl.Height := 700;
  cl.Width := 200;
  cl.Height := 200;
  cl.Parent := Form1;
  cl.FKol_vo := 25;
  cl.Visible := true;
end;

end.
Изображения
Тип файла: jpg test2.JPG (11.0 Кб, 155 просмотров)
vasily86 вне форума Ответить с цитированием
Ответ


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



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Перерисовка окна при момощи InvalidateRect assch Assembler - Ассемблер (FASM, MASM, WASM, NASM, GoASM, Gas, RosAsm, HLA) и не рекомендуем TASM 2 01.07.2011 19:49
перерисовка/обновление клиентской области окна ImmortalAlexSan Общие вопросы Delphi 0 09.01.2011 16:19
Перерисовка в ShellListView artemavd Общие вопросы Delphi 2 04.04.2010 19:18
Перерисовка окна _Dmitry_ Win Api 3 30.03.2010 19:55
Перерисовка формы satana Общие вопросы Delphi 4 18.09.2007 19:42