DrawGrid & Drag&Drop

@Iwillbeagod · Регистрация: 19.12.2012

Студворк — интернет-сервис помощи студентам

Здравствуйте. Суть вопроса - поставлена задача по заполнению TDrawGrid формата 5х5 изображениями одинакового размера (одна ячейка должна остаться свободной) и организации внутри него Drag&Drop. Я написал программу, но:

Drag&Drop срабатывает нормально, то есть изображение из ячейки-источника стирается и отображается в приемнике, но при следующей активации Drag&Drop ячейка-источник предыдущего снова заполняется имевшимся там изображением, чего по задумке быть не должно. Пытался исправить сам - не выходит. Помогите

Код:

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
unit Sonya;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Grids, ExtCtrls, XPStyleActnCtrls, ActnList, ActnMan, StdCtrls;
 
const SIZE=5;
type p_list=array[1..SIZE*SIZE] of string;
type
  TForm1 = class(TForm)
    DrawGrid1: TDrawGrid;
    ActionManager1: TActionManager;
    Button1: TButton;
    procedure DrawGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure FormCreate(Sender: TObject);
    procedure DrawGrid1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure DrawGrid1DragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure DrawGrid1DragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
  SourceCol,SourceRow,DestCol,DestRow:integer;
  a:p_list;
  count:byte;
  BitMap:TBitMap;
 
implementation
 
 
{$R *.dfm}
 
procedure TForm1.DrawGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
var i:byte;
  begin
    i:=ARow*DrawGrid1.ColCount + ACol;
          if ((ACol=0)and(ARow=0))or((ARow=SourceRow)and(ACol=SourceCol))or((ARow=DestRow)and(ACol=DestCol))
          then DrawGrid1.Canvas.FillRect(ClientRect)
          else
          begin
            BitMap.LoadFromFile(a[i]);
            Rect:=DrawGrid1.CellRect(ACol,ARow);
            DrawGrid1.Canvas.StretchDraw(Rect,BitMap);
         end;
  end;
 
procedure TForm1.FormCreate(Sender: TObject);
var i:byte;
    SearchRec:TSearchRec;
  begin
    randomize;
    BitMap:=TBitMap.Create;
    Form1.DoubleBuffered:=True;
    DrawGrid1.Visible:=False;
    DrawGrid1.DefaultColWidth:=BitMap.Width+50;
    DrawGrid1.DefaultRowHeight:=50;
    DrawGrid1.Height:=DrawGrid1.DefaultRowHeight*(SIZE+1);
    DrawGrid1.Width:=DrawGrid1.DefaultColWidth*(SIZE+1);
    DrawGrid1.RowCount:=SIZE;
    DrawGrid1.ColCount:=SIZE;
    DrawGrid1.DoubleBuffered:=True;
    DrawGrid1.Visible:=True;
    DrawGrid1.DragMode:=dmManual;
    i:=1;
    count:=1;
    if FindFirst('*.bmp',faAnyFile,SearchRec)=0
      then
        while FindNext(SearchRec)=0 do
          begin
            a[i]:=SearchRec.Name;
            inc(i);
          end;
    count:=i;
  end;
 
 
procedure TForm1.DrawGrid1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  DrawGrid1.MouseToCell(x,y,SourceCol,SourceRow);
  if button=mbLeft then TDrawGrid(Sender).BeginDrag(True);
end;
 
procedure TForm1.DrawGrid1DragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
var CurrentCol,CurrentRow:integer;
  begin
    DrawGrid1.MouseToCell(x,y,CurrentCol,CurrentRow);
    Accept:=Sender is TDrawGrid;
  end;
 
procedure TForm1.DrawGrid1DragDrop(Sender, Source: TObject; X, Y: Integer);
var Rect:TRect;
    i:byte;
  begin
    i:=TDrawGrid(Source).Row*SIZE+(TDrawGrid(Source).Col);
    DrawGrid1.MouseToCell(x,y,DestCol,DestRow);
    Rect:=DrawGrid1.CellRect(SourceCol,SourceRow);
    DrawGrid1.Canvas.FillRect(Rect);
    BitMap.LoadFromFile(a[i]);
    Rect:=DrawGrid1.CellRect(DestCol,DestRow);
    DrawGrid1.Canvas.StretchDraw(Rect,BitMap);
  end;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  BitMap.Free;
  close
end;
 
end.

Спасибо.

@RinatV · 19.12.2012, 19:25

У вас когда идет перерисовка все возвращается на место, нужно также разменивать имена в массиве a

@volvo · 19.12.2012, 19:27

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
var
  SourceCol,SourceRow,DestCol,DestRow:integer;
  EmptyCol, EmptyRow : Integer; // <--- Добавляешь 
 
//
procedure TForm1.DrawGrid1DragDrop(Sender, Source: TObject; X, Y: Integer);
var Rect:TRect;
    i:byte;
  begin
    // Если не добавить следующую строку, то при начале драга пустой ячейки,
    // и отпускании прямо в пределах этой же пустой ячейки, там появится картинка.
    if (SourceCol = EmptyCol) and (SourceRow = EmptyRow) then Exit;
 
    i:=TDrawGrid(Source).Row*SIZE+(TDrawGrid(Source).Col);
    DrawGrid1.MouseToCell(x,y,DestCol,DestRow);
    Rect:=DrawGrid1.CellRect(SourceCol,SourceRow);
    DrawGrid1.Canvas.FillRect(Rect);
    BitMap.LoadFromFile(a[i]);
    Rect:=DrawGrid1.CellRect(DestCol,DestRow);
    DrawGrid1.Canvas.StretchDraw(Rect,BitMap);
 
    EmptyCol := SourceCol; // <--- Добавляешь
    EmptyRow := SourceRow;
  end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
   // ...
   EmptyCol := 0; // Инициализируешь
   EmptyRow := 0;
end.
 
procedure TForm1.DrawGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
var i:byte;
  begin
    i:=ARow*DrawGrid1.ColCount + ACol;
          if (ACol = EmptyCol) and (ARow = EmptyRow) // Вот так проверяешь, надо ли рисовать клетку
          then DrawGrid1.Canvas.FillRect(ClientRect)
          else
          begin
            BitMap.LoadFromFile(a[i]);
            Rect:=DrawGrid1.CellRect(ACol,ARow);
            DrawGrid1.Canvas.StretchDraw(Rect,BitMap);
         end;
  end;

Ну, и о том, что написано в предыдущем посте, не забывай.

@Iwillbeagod · 20.12.2012, 14:36 **[ТС]**

Сообщение от RinatV

У вас когда идет перерисовка все возвращается на место, нужно также разменивать имена в массиве a

Не совсем Вас понял. По какому принципу разменивать?

Добавлено через 14 часов 42 минуты
Учтя советы UI, несколько модернизировал код, и так и не поняв про роазмен имен, решил сделать следующее - создать массив записей с двумя полями (Scol и Srow), и при каждом OnDrag'e записывать в него инддексы ячейки из которой драг, а потом при DrawCell'e проверять, есть ли текущая ячейка в этом списке и если есть то ее не перерисовывать. Но при заполнении массива возникает Access Violation (в коде указано в каком месте). Я толкомникогда не работал с динамическими массивами, подскажите, в чем моя ошибка:

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
const SIZE=5;
type list=record
       SCol:Integer;
       SRow:Integer;
     end;
type ar=array of list;
type p_list=array[1..SIZE*SIZE] of string;
type
  TForm1 = class(TForm)
    DrawGrid1: TDrawGrid;
    ActionManager1: TActionManager;
    Button1: TButton;
    procedure DrawGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure FormCreate(Sender: TObject);
    procedure DrawGrid1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure DrawGrid1DragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure DrawGrid1DragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
  SourceCol,SourceRow,DestCol,DestRow,EmptyCol,EmptyRow:integer;
  a:p_list;
  b:ar;
  j:byte;
  BitMap:TBitMap;
 
implementation
 
 
{$R *.dfm}
 
procedure TForm1.DrawGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
var i,k:byte;
  begin
    i:=ARow*DrawGrid1.ColCount + ACol;
          for k:=0 to j do
            begin
              if j<1 then break;
              if (ACol=b[k].SCol)and(ARow=b[k].SRow) then exit;
            end;
          if(ARow=EmptyRow)and(ACol=EmptyCol)
          then DrawGrid1.Canvas.FillRect(ClientRect)
          else
          begin
            BitMap.LoadFromFile(a[i]);
            Rect:=DrawGrid1.CellRect(ACol,ARow);
            DrawGrid1.Canvas.StretchDraw(Rect,BitMap);
         end;
  end;
 
procedure TForm1.FormCreate(Sender: TObject);
var i:byte;
    SearchRec:TSearchRec;
  begin
    randomize;
    BitMap:=TBitMap.Create;
    Form1.DoubleBuffered:=True;
    DrawGrid1.Visible:=False;
    DrawGrid1.DefaultColWidth:=BitMap.Width+50;
    DrawGrid1.DefaultRowHeight:=50;
    DrawGrid1.Height:=DrawGrid1.DefaultRowHeight*(SIZE+1);
    DrawGrid1.Width:=DrawGrid1.DefaultColWidth*(SIZE+1);
    DrawGrid1.RowCount:=SIZE;
    DrawGrid1.ColCount:=SIZE;
    DrawGrid1.DoubleBuffered:=True;
    DrawGrid1.Visible:=True;
    DrawGrid1.DragMode:=dmManual;
    i:=1;
    j:=0;
    EmptyCol:=0;
    EmptyRow:=0;
    if FindFirst('*.bmp',faAnyFile,SearchRec)=0
      then
        while FindNext(SearchRec)=0 do
          begin
            a[i]:=SearchRec.Name;
            inc(i);
          end;
  end;
 
 
procedure TForm1.DrawGrid1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  DrawGrid1.MouseToCell(x,y,SourceCol,SourceRow);
  if button=mbLeft then
    begin
      TDrawGrid(Sender).BeginDrag(True);
      //b[j].SCol:=SourceCol;          Çäåñü âîçíèêàåò Access Violation
      //b[j].SRow:=SourceRow;
      inc(j);
      SetLength(b,j);
    end;
end;
 
procedure TForm1.DrawGrid1DragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
var CurrentCol,CurrentRow:integer;
  begin
    DrawGrid1.MouseToCell(x,y,CurrentCol,CurrentRow);
    Accept:=Sender is TDrawGrid;
  end;
 
procedure TForm1.DrawGrid1DragDrop(Sender, Source: TObject; X, Y: Integer);
var Rect:TRect;
    i:byte;
  begin
    i:=TDrawGrid(Source).Row*SIZE+(TDrawGrid(Source).Col);
    if (SourceCol = EmptyCol) and (SourceRow = EmptyRow) then Exit;
    DrawGrid1.MouseToCell(x,y,DestCol,DestRow);
    Rect:=DrawGrid1.CellRect(SourceCol,SourceRow);
    DrawGrid1.Canvas.FillRect(Rect);
    BitMap.LoadFromFile(a[i]);
    Rect:=DrawGrid1.CellRect(DestCol,DestRow);
    DrawGrid1.Canvas.StretchDraw(Rect,BitMap);
  end;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  BitMap.Free;
  close
end;
 
end.

Добавлено через 7 минут
Все это, конечно, пляски с бубном

так что если кто-то просто подскажет как правильно реализовать OnDrawCell, то буду благодарен

@volvo · 20.12.2012, 17:25

Я бы вообще сделал вот так:

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Grids;
 
const
  Size = 5;
type
  p_list = array[0 .. Pred(Size*Size)] of string;
 
  TForm1 = class(TForm)
    DrawGrid1: TDrawGrid;
    Button1: TButton;
    procedure DrawGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure FormCreate(Sender: TObject);
    procedure DrawGrid1DragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure DrawGrid1DragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure Button1Click(Sender: TObject);
    procedure DrawGrid1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
    bm : TBitmap;
 
    EmptyIndex, DraggedIndex, DroppedIndex : Integer;
    a : p_list;
    function ArrayIndex(ACol, ARow : Integer) : Integer; overload;
    function ArrayIndex(Grid : TDrawGrid; X, Y : Integer) : Integer; overload;
    procedure ArraySwap(FirstIndex, SecondIndex : Integer);
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
function TForm1.ArrayIndex(ACol, ARow: Integer): Integer;
begin
   Result := ARow * DrawGrid1.ColCount + ACol;
end;
 
function TForm1.ArrayIndex(Grid: TDrawGrid; X, Y: Integer): Integer;
var ACol, ARow : Integer;
begin
   Grid.MouseToCell(x, y, ACol, ARow);
   Result := ArrayIndex(ACol, ARow);
end;
 
procedure TForm1.ArraySwap(FirstIndex, SecondIndex: Integer);
var T : string;
begin
   T := a[FirstIndex];
   a[FirstIndex] := a[SecondIndex];
   a[SecondIndex] := T;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  bm.Free;
  Close
end;
 
procedure TForm1.DrawGrid1DragDrop(Sender, Source: TObject; X, Y: Integer);
begin
   DroppedIndex := ArrayIndex(DrawGrid1, X, Y);
   if DraggedIndex = DroppedIndex then Exit;
 
   EmptyIndex := DraggedIndex;
   ArraySwap(DraggedIndex, DroppedIndex);
   DrawGrid1.Invalidate;
end;
 
procedure TForm1.DrawGrid1DragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
   Accept := (Sender is TDrawGrid) and (a[ArrayIndex(DrawGrid1, X, Y)] = '');
end;
 
procedure TForm1.DrawGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
var Index : Integer;
begin
   Index := ArrayIndex(ACol, ARow);
   if Index = EmptyIndex then
      DrawGrid1.Canvas.FillRect(Rect)
   else
   begin
      bm.LoadFromFile(a[Index]);
      Rect := DrawGrid1.CellRect(ACol,ARow);
      DrawGrid1.Canvas.StretchDraw(Rect, bm);
   end;
end;
 
procedure TForm1.DrawGrid1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  DraggedIndex := ArrayIndex(DrawGrid1, X, Y);
  if button=mbLeft then TDrawGrid(Sender).BeginDrag(True);
end;
 
procedure TForm1.FormCreate(Sender: TObject);
var i:byte;
    SearchRec:TSearchRec;
begin
   i := 0;
   if FindFirst('*.bmp', faAnyFile, SearchRec) = 0 then
   repeat
      if SearchRec.Attr and faDirectory <> faDirectory then
      begin
         inc(i);
         a[i] := SearchRec.Name;
      end;
   until FindNext(SearchRec) <> 0;
 
   EmptyIndex := ArrayIndex(0, 0);
 
   randomize;
   bm := TBitMap.Create;
   Form1.DoubleBuffered:=True;
 
   with DrawGrid1 do
   begin
      Visible:=False;
      DefaultColWidth:=bm.Width+50;
      DefaultRowHeight:=50;
      Height:=DefaultRowHeight*(SIZE+1);
      Width:=DefaultColWidth*(SIZE+1);
      RowCount:=SIZE;
      ColCount:=SIZE;
      FixedCols := 0;
      FixedRows := 0;
      DoubleBuffered:=True;
      Visible:=True;
      DragMode:=dmManual;
   end;
end;
 
end.

, и это прекрасно переносит изображения из заполненной ячейки в пустую.

@Iwillbeagod · 20.12.2012, 20:05 **[ТС]**

Спасибо. Взяв за основу Ваш код, я переписал проект следующим образом:

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
unit Sonya;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Grids, ExtCtrls, XPStyleActnCtrls, ActnList, ActnMan, StdCtrls;
 
const SIZE=5;
type p_list=array[1..pred(SIZE*SIZE)] of string;
type
  TForm1 = class(TForm)
    DrawGrid1: TDrawGrid;
    ActionManager1: TActionManager;
    Button1: TButton;
    procedure DrawGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure FormCreate(Sender: TObject);
    procedure DrawGrid1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure DrawGrid1DragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure DrawGrid1DragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure Button1Click(Sender: TObject);
  private
    EmptyIndex, DraggedIndex, DroppedIndex : Integer;
    a:p_list;
    BitMap:TBitMap;
    function ArrayIndex(ACol, ARow : Integer) : Integer; overload;
    function ArrayIndex(Grid : TDrawGrid; X, Y : Integer) : Integer; overload;
    procedure ArraySwap(FirstIndex, SecondIndex : Integer);
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
 
{$R *.dfm}
 
function TForm1.ArrayIndex(ACol, ARow: Integer): Integer;
begin
   Result := ARow * DrawGrid1.ColCount + ACol;
end;
 
function TForm1.ArrayIndex(Grid: TDrawGrid; X, Y: Integer): Integer;
var ACol, ARow : Integer;
begin
   Grid.MouseToCell(x, y, ACol, ARow);
   Result := ArrayIndex(ACol, ARow);
end;
 
procedure TForm1.ArraySwap(FirstIndex, SecondIndex: Integer);
var Tmp : string;
begin
   Tmp := a[FirstIndex];
   a[FirstIndex] := a[SecondIndex];
   a[SecondIndex] := Tmp;
end;
 
procedure TForm1.DrawGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
var Index : Integer;
begin
   Index := ArrayIndex(ACol, ARow);
   if Index = EmptyIndex then
      DrawGrid1.Canvas.FillRect(Rect)
   else
   begin
      BitMap.LoadFromFile(a[Index]);
      Rect := DrawGrid1.CellRect(ACol,ARow);
      DrawGrid1.Canvas.StretchDraw(Rect, BitMap);
   end;
  end;
 
procedure TForm1.FormCreate(Sender: TObject);
var i:byte;
    SearchRec:TSearchRec;
  begin
    BitMap:=TBitMap.Create;
    Form1.DoubleBuffered:=True;
    DrawGrid1.Visible:=False;
    DrawGrid1.DefaultColWidth:=50;
    DrawGrid1.DefaultRowHeight:=50;
    DrawGrid1.Height:=DrawGrid1.DefaultRowHeight*(SIZE+1);
    DrawGrid1.Width:=DrawGrid1.DefaultColWidth*(SIZE+1);
    DrawGrid1.RowCount:=SIZE;
    DrawGrid1.ColCount:=SIZE;
    DrawGrid1.DoubleBuffered:=True;
    DrawGrid1.Visible:=True;
    DrawGrid1.DragMode:=dmManual;
    EmptyIndex := ArrayIndex(0, 0);
    i:=0;
    if FindFirst('*.bmp',faAnyFile,SearchRec)=0
      then
        while FindNext(SearchRec)=0 do
          begin
            inc(i);
            a[i]:=SearchRec.Name;
          end;
  end;
 
 
procedure TForm1.DrawGrid1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  DraggedIndex := ArrayIndex(DrawGrid1, X, Y);
  if button=mbLeft then TDrawGrid(Sender).BeginDrag(True);
end;
 
procedure TForm1.DrawGrid1DragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
  begin
    Accept:=(Sender is TDrawGrid)and(a[ArrayIndex(DrawGrid1, X, Y)] = '');
  end;
 
procedure TForm1.DrawGrid1DragDrop(Sender, Source: TObject; X, Y: Integer);
  begin
    DroppedIndex := ArrayIndex(DrawGrid1, X, Y);
    if DraggedIndex = DroppedIndex then Exit;
    EmptyIndex := DraggedIndex;
    ArraySwap(DraggedIndex, DroppedIndex);
    DrawGrid1.Invalidate;
  end;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  BitMap.Free;
  close
end;
 
end.

Первый драгдроп срабатывает нормально, но при втором программа рушится с Access Violation в процедуре OnDrawCell, а конкретно - при отрисовке прямоугольника на канве. Не могу найти ошибку, помогите пожалуйста

@volvo · 20.12.2012, 22:00

Кто просил менять начало индексации массива с 0 на 1, но при этом оставлять конечный элемент Pred(Size*Size)? У меня функции ArrayIndex возвращают индекс от 0, у тебя нулевого элемента вообще нет. Вылет гарантирован, как только пустая ячейка будет не в левом верхнем углу.

@Iwillbeagod · 20.12.2012, 22:17 **[ТС]**

Сообщение от UI

Кто просил менять начало индексации массива с 0 на 1, но при этом оставлять конечный элемент Pred(Size*Size)? У меня функции ArrayIndex возвращают индекс от 0, у тебя нулевого элемента вообще нет. Вылет гарантирован, как только пустая ячейка будет не в левом верхнем углу.

Вылет и при массиве [0...pred(SIZE*SIZE)], и при [1..(SIZE*SIZE], и даже при [1..pred(SIZE*SIZE)] либо [0..(SIZE*SIZE)]

@volvo · 20.12.2012, 22:46

Еще бы. Ты ж не меняешь всё, что связано с нумерацией. Вот посмотри, как заполняется у тебя массив. Какой первый элемент будет заполнен? Первый. А при попытке отрисовать левую верхнюю ячейку нужен НУЛЕВОЙ.

Отсюда вопрос: на фиг было переделывать? Выложенный мной код тестировался и работает прекрасно. Нет, надо извратить, а потом говорить "не работает", да?

@Iwillbeagod · 21.12.2012, 02:31 **[ТС]**

Сообщение от UI

Еще бы. Ты ж не меняешь всё, что связано с нумерацией. Вот посмотри, как заполняется у тебя массив. Какой первый элемент будет заполнен? Первый. А при попытке отрисовать левую верхнюю ячейку нужен НУЛЕВОЙ.

Отсюда вопрос: на фиг было переделывать? Выложенный мной код тестировался и работает прекрасно. Нет, надо извратить, а потом говорить "не работает", да?

Наверное вы правы)) просто я не очень понял смысл всей этой свистопляски с массивом, а хочется) отсюда и извращение)

P.S. А Ваш код лично у меня дроугрид не заполняет вообще при наличии:

Delphi
1
if SearchRec.Attr and faDirectory <> faDirectory then ...

Пришлось экспериментировать, но, видимо, не там где надо)

@volvo · 21.12.2012, 02:54

В аттаче - проект для Дельфи 2009+, нормально всё отображается (искать 25 разных изображений было лень ,поэтому я просто пронумеровал одну и ту же картинку, чтобы видеть разницу)...

Новые блоги и статьи Все статьи Все блоги /
Модель микоризы: классовый агентный подход anaschu 02.01.2026 Раньше это было два гриба и бактерия. Теперь три гриба, растение. И на уровне агентов добавится между грибами или бактериями взаимодействий. До того я пробовал подход через многомерные массивы,. . .	Учёным и волонтёрам проекта «Einstein@home» удалось обнаружить четыре гамма-лучевых пульсара в джете Млечного Пути Programma_Boinc 01.01.2026 Учёным и волонтёрам проекта «Einstein@home» удалось обнаружить четыре гамма-лучевых пульсара в джете Млечного Пути Сочетание глобально распределённой вычислительной мощности и инновационных. . .	Советы по крайней бережливости. Внимание, это ОЧЕНЬ длинный пост. Programma_Boinc 28.12.2025 Советы по крайней бережливости. Внимание, это ОЧЕНЬ длинный пост. Налог на собак: https:/ / ********/ gallery/ V06K53e Финансовый отчет в Excel: https:/ / ********/ gallery/ bKBkQFf Пост отсюда. . .	Кто-нибудь знает, где можно бесплатно получить настольный компьютер или ноутбук? США. Programma_Boinc 26.12.2025 Нашел на реддите интересную статью под названием Anyone know where to get a free Desktop or Laptop? Ниже её машинный перевод. После долгих разбирательств я наконец-то вернула себе. . .	Thinkpad X220 Tablet — это лучший бюджетный ноутбук для учёбы, точка. Programma_Boinc 23.12.2025 Рецензия / Мнение/ Перевод Нашел на реддите интересную статью под названием The Thinkpad X220 Tablet is the best budget school laptop period . Ниже её машинный перевод. Thinkpad X220 Tablet —. . .
PhpStorm 2025.3: WSL Terminal всегда стартует в ~ and_y87 14.12.2025 PhpStorm 2025. 3: WSL Terminal всегда стартует в ~ (home), игнорируя директорию проекта Симптом: После обновления до PhpStorm 2025. 3 встроенный терминал WSL открывается в домашней директории. . .	Как объединить две одинаковые БД Access с разными данными VikBal 11.12.2025 Помогите пожалуйста !! Как объединить 2 одинаковые БД Access с разными данными.	Новый ноутбук volvo 07.12.2025 Всем привет. По скидке в "черную пятницу" взял себе новый ноутбук Lenovo ThinkBook 16 G7 на Амазоне: Ryzen 5 7533HS 64 Gb DDR5 1Tb NVMe 16" Full HD Display Win11 Pro	Музыка, написанная Искусственным Интеллектом volvo 04.12.2025 Всем привет. Некоторое время назад меня заинтересовало, что уже умеет ИИ в плане написания музыки для песен, и, собственно, исполнения этих самых песен. Стихов у нас много, уже вышли 4 книги, еще 3. . .	От async/await к виртуальным потокам в Python IndentationError 23.11.2025 Армин Ронахер поставил под сомнение async/ await. Создатель Flask заявляет: цветные функции - провал, виртуальные потоки - решение. Не threading-динозавры, а новое поколение лёгких потоков. Откат?. . .

@RinatV http://1248.site 130 / 118 / 20 Регистрация: 15.05.2012 Сообщений: 342 Записей в блоге: 10
	19.12.2012, 19:25
	У вас когда идет перерисовка все возвращается на место, нужно также разменивать имена в массиве a 0

@volvo Супер-модератор 33198 / 21494 / 8233 Регистрация: 22.10.2011 Сообщений: 36,888 Записей в блоге: 12
	20.12.2012, 22:00
	Кто просил менять начало индексации массива с 0 на 1, но при этом оставлять конечный элемент Pred(Size*Size)? У меня функции ArrayIndex возвращают индекс от 0, у тебя нулевого элемента вообще нет. Вылет гарантирован, как только пустая ячейка будет не в левом верхнем углу. 0

@volvo Супер-модератор 33198 / 21494 / 8233 Регистрация: 22.10.2011 Сообщений: 36,888 Записей в блоге: 12
	20.12.2012, 22:46
	Еще бы. Ты ж не меняешь всё, что связано с нумерацией. Вот посмотри, как заполняется у тебя массив. Какой первый элемент будет заполнен? Первый. А при попытке отрисовать левую верхнюю ячейку нужен НУЛЕВОЙ. Отсюда вопрос: на фиг было переделывать? Выложенный мной код тестировался и работает прекрасно. Нет, надо извратить, а потом говорить "не работает", да? 0