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

Вниз

Помогите ускорить скорость перемещения "курсора".   Найти похожие ветки 

← →
yaproq   (2013-01-14 08:36) [0]

Нужно было сделать таблицу, как лист Excel, где есть возможность объединить ячейки, задавать формат отдельных ячеек. Так как еще не умею создавать компоненты, решил так. Динамически создаю двумерный массив компонентов TLabel и программно управляю их поведением и т.д. В качестве курсора пользуюсь компонентом TShape. В обработчике KeyDown формы перемещаю "курсор". Но скорость перемещения (перерисовки?) очень медленная по сравнении со скоростью того же курсора из Excel.

Посоветуйте, пожалуйста, как можно ускорить скорость перемещения (перерисовки) этого "курсора"?

Ниже упрошенный пример моего решения. Его нужно просто вставить в модуль пустого проекта.


unit Unit1;

interface

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

type
 lbl = array of array of TLabel;

 TForm1 = class(TForm)
   procedure FormShow(Sender: TObject);
   procedure FormCreate(Sender: TObject);
   procedure FormKeyDown(Sender: TObject; var Key: Word;
     Shift: TShiftState);
 private
   { Private declarations }
   FirstShow : boolean;
   arrLbl : lbl;

   shp    : TShape;
   n,m    : byte;
   cx,cy  : integer;
   procedure CreateLabels;
   procedure resetcursorpos(cx,cy : integer);
 public
   { Public declarations }
 end;

var
 Form1: TForm1;
implementation

{$R *.dfm}

procedure TForm1.resetcursorpos(cx, cy : integer);
begin
    shp.Left := arrLbl[cy,cx].Left+2;
    shp.top := arrLbl[cy,cx].Top+2;
end;

procedure TForm1.CreateLabels;
var i,j    : byte;
   x,y,t  : integer;
   ww     : integer;

begin
    ww := 25;
    n := 50; m:=50;
    SetLength(arrlbl, n,m);
    x := 0; y:=0; t:=0;
    for i := 0 to n-1 do
    begin
         for j := 0 to m-1 do
         begin
              arrLbl[i,j] := TLabel.Create(Form1);
              arrLbl[i,j].Top := y;
              arrLbl[i,j].Left := x;
              arrLbl[i,j].Width := ww;
              arrLbl[i,j].Height := ww div 2;
              arrLbl[i,j].AutoSize := False;
              arrLbl[i,j].Font.Name := "Times New Roman";
              arrLbl[i,j].Font.Size := 8;
              arrLbl[i,j].Caption := inttostr(t);
              arrLbl[i,j].Color := clLime;
              arrLbl[i,j].Parent := Form1;
              x:=x+ww +1;
              Inc(t);
         end;
         x:=0;
         y:=y+ww div 2 +1;
    end;
    cx := 0; cy := 0;
    shp := TShape.Create(Form1);
    shp.Shape := stCircle;
    shp.Width := ww -2;
    shp.Height := ww  div 2 -2;
    shp.Brush.Style := bsClear;
    shp.Pen.Width := 4;
    shp.Parent := Form1;
    shp.BringToFront;
    resetcursorpos(cx,cy);
end;

procedure TForm1.FormShow(Sender: TObject);
begin
   Form1.WindowState := wsMaximized;
   if FirstShow then CreateLabels;
   FirstShow := False;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
    FirstShow := True;
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
 Shift: TShiftState);
begin
    case key of
        VK_RIGHT :  begin
                         if not (cx = n-1) then
                         begin
                              cx:=cx+1;
                              resetcursorpos(cx,cy);
                         end;
                    end;
        VK_DOWN :  begin
                         if not (cy = m-1) then
                         begin
                              cy:=cy+1;
                              resetcursorpos(cx,cy);
                         end;
                    end;
        VK_LEFT :  begin
                         if not (cx = 0) then
                         begin
                              cx:=cx-1;
                              resetcursorpos(cx,cy);
                         end;
                    end;
        VK_UP  :    begin
                         if not (cy = 0) then
                         begin
                              cy:=cy-1;
                              resetcursorpos(cx,cy);
                         end;
                    end;
    end;
end;

end.


---

← →
O'ShinW ©   (2013-01-14 09:03) [1]

Думаю, вариантов тут 2.
1. Скакать через ячейку. Т.е. после N перемещений начинать перемещать сразу на 2(два раза вызывать resetcursorpos() ).

2. Перемещает таймер.
Пока нажата кнопка курсора запускаем таймер, который вызывает resetcursorpos(). Пока кнопка курсора не отпущена, таймер убавляет свой интервал, и следующий вызов будет быстрее.
(и не забыть "съесть нажатие кнопки" )

---

← →
sniknik ©   (2013-01-14 09:53) [2]

данный способ (двигая компонент) вызывает перерисовку формы после каждого нажатия. в ехселе перерисовывает только нужное (отрисовка самостоятельная). возможно в этом и разница скорости.

---

← →
sniknik ©   (2013-01-14 10:42) [3]

чисто для пробы, замена (должно быть быстрее)
procedure TForm1.resetcursorpos(cx, cy : integer);
const
 wx = 50;
 hy = 20;
begin
 with Canvas do begin
   Pen.Style:= psDot;
   Pen.Width:= 2;
   Brush.Style:= bsClear;
   Rectangle(cx*wx, cy*hy, cx*wx+50, cy*hy+20);
 end;  
end;

---

← →
brother ©   (2013-01-14 10:50) [4]

> в ехселе перерисовывает только нужное (отрисовка самостоятельная)

после моих изысканий пришел к выводу - перерисовывается ВСЕ!

---

← →
sniknik ©   (2013-01-14 10:56) [5]

> перерисовывается ВСЕ!
значит более быстро... у него там все таки матрица 50 * 50 из лейблов, а не 1... /пара, несколько(немного) компонентов.

---

← →
yaproq ©   (2013-01-14 11:06) [6]

Думаю, добился. По подсказке sniknik копал в сторону Canvas.
Перемещение "курсора" осуществляю так:
1) В обработчике нажатия клавиши перерисовываю только текущий Label (Label.Repaint), чтобы удалить чертеж Канва.
2) Перемешаю Канва в нужное место (Canvas.MoveTo(x,y)).
3) Рисую нужную фигуру. Все.

Только одна проблема. Если свернуть окно и снова развернуть, то рисунок исчезает. В каком обработчике можно это устранить?

Вот измененный код:

unit Unit1;

interface

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

type
 coord = record
     x : integer;
     y : integer;
 end;
 lbl = array of array of TLabel;

 TForm1 = class(TForm)
   procedure FormShow(Sender: TObject);
   procedure FormCreate(Sender: TObject);
   procedure FormKeyDown(Sender: TObject; var Key: Word;
     Shift: TShiftState);
 private
   { Private declarations }
   FirstShow : boolean;
   arrLbl : lbl;

   shp    : TShape;
   n,m    : byte;
   cx,cy  : integer;
   procedure CreateLabels;
   procedure resetcursorpos(cx,cy : integer);
 public
   { Public declarations }
 end;

var
 Form1: TForm1;
implementation

{$R *.dfm}

procedure TForm1.resetcursorpos(cx, cy : integer);
var x1,x2, y1, y2 : integer;
begin
    x1 := arrLbl[cy,cx].Left+2;
    x2 := arrLbl[cy,cx].Left + arrLbl[cy,cx].Width - 2;
    y1 := arrLbl[cy,cx].Top + 2;
    y2 := arrLbl[cy,cx].Top + arrLbl[cy,cx].Height - 2;
    Canvas.MoveTo(x1, y1);
    Canvas.Brush.Style := bsClear;
    Canvas.Rectangle(x1, y1, x2, y2);

(*     shp.Left := arrLbl[cy,cx].Left+2;
    shp.top := arrLbl[cy,cx].Top+2;
*)
end;

procedure TForm1.CreateLabels;
var i,j    : byte;
   x,y,t  : integer;
   ww     : integer;

begin
    ww := 25;
    n := 100; m:=100;
    SetLength(arrlbl, n,m);
    x := 0; y:=0; t:=0;
    for i := 0 to n-1 do
    begin
         for j := 0 to m-1 do
         begin
              arrLbl[i,j] := TLabel.Create(Form1);
              arrLbl[i,j].Top := y;
              arrLbl[i,j].Left := x;
              arrLbl[i,j].Width := ww;
              arrLbl[i,j].Height := ww div 2;
              arrLbl[i,j].AutoSize := False;
              arrLbl[i,j].Font.Name := "Times New Roman";
              arrLbl[i,j].Font.Size := 8;
              arrLbl[i,j].Caption := inttostr(t);
              arrLbl[i,j].Color := clLime;
              arrLbl[i,j].Parent := Form1;
              x:=x+ww +1;
              Inc(t);
         end;
         x:=0;
         y:=y+ww div 2 +1;
    end;
    cx := 0; cy := 0;
    shp := TShape.Create(Form1);
    shp.Shape := stCircle;
    shp.Width := ww -2;
    shp.Height := ww  div 2 -2;
    shp.Brush.Style := bsClear;
    shp.Pen.Width := 4;
    shp.Parent := Form1;
    shp.BringToFront;
    resetcursorpos(cx,cy);
end;

procedure TForm1.FormShow(Sender: TObject);
begin
   Form1.WindowState := wsMaximized;
   if FirstShow then CreateLabels;
   FirstShow := False;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
    FirstShow := True;
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
 Shift: TShiftState);
begin
    case key of
        VK_RIGHT :  begin
                         if not (cx = n-1) then
                         begin
                              arrLbl[cy,cx].Repaint;
                              cx:=cx+1;
                              resetcursorpos(cx,cy);
                         end;
                    end;
        VK_DOWN :  begin
                         arrLbl[cy,cx].Repaint;
                         if not (cy = m-1) then
                         begin
                              cy:=cy+1;
                              resetcursorpos(cx,cy);
                         end;
                    end;
        VK_LEFT :  begin
                         arrLbl[cy,cx].Repaint;
                         if not (cx = 0) then
                         begin
                              cx:=cx-1;
                              resetcursorpos(cx,cy);
                         end;
                    end;
        VK_UP  :    begin
                         arrLbl[cy,cx].Repaint;
                         if not (cy = 0) then
                         begin
                              cy:=cy-1;
                              resetcursorpos(cx,cy);
                         end;
                    end;
    end;
end;

end.


---

← →
sniknik ©   (2013-01-14 11:35) [7]

> В каком обработчике можно это устранить?
onPaint. но вообще лучше изменить подход. даже стринггрид лучше чем куча лейблов.

---

← →
yaproq ©   (2013-01-14 11:40) [8]

Спасибо, sniknik.

---

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

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

Наверх

Память: 0.51 MB
Время: 0.009 c