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

Вниз

StringGrid.Objects   Найти похожие ветки 

← →
Некто   (2016-11-08 19:01) [0]

Windows 10, Turbo Delphi 2006.

Здравствуйте все!

Чтобы не плодить лишних сущностей я решил для передачи информации о цвете ячеек использовать свойство Objects[ACol,ARow]  в StringGrid, однако не хочет работать. Никаких ошибок не выдаёт.

В обработчике события StringGridMagazinDrawCell все значения в Objects[0,ARow] = nil и только почемуто с ARow = 55 не nil.

В отладчике вижу, что проседура Vrgleichen работает корректно, т.е. пишет значения 1 или 0 в соответствии с логикой.

Если вместо Objects создаю динамический массив - всё работает, как и задумано.


procedure Vergleichen(MagGrid, PrgGrid: TStringGrid);
var
 i,j,k: Integer;
 MagStr, PrgStr: string;
 Fund: Integer;
begin
 for i := 1 to MagGrid.RowCount - 1 do
 begin
   k := 1;
   MagStr := MagGrid.Cells[1,i];
   Fund := 0;
   while (k <= Length(MagStr)) do
   begin
     if (MagStr[k] = " ") then
       Inc(Fund);

     if (Fund > 2) then
     begin
       MagStr := Copy(MagStr,1,k-1);
       Break;
     end;

     Inc(k);
   end;
   for j := 1 to PrgGrid.RowCount - 1 do
   begin
     k := 1;
     PrgStr := PrgGrid.Cells[1,j];
     Fund := 0;
     while (k <= Length(PrgStr)) do
     begin
       if (PrgStr[k] = " ") then
         Inc(Fund);

       if (Fund > 2) then
       begin
         PrgStr := Copy(PrgStr,1,k-1);
         Break;
       end;

       Inc(k);
     end;
     if MagStr = PrgStr then
       MagGrid.Objects[0,i] := Pointer(1)
     else
       MagGrid.Objects[0,i] := Pointer(0);

   end;
 end;

 MagGrid.Invalidate;
end;

procedure TForm1.StringGridMagazinDrawCell(Sender: TObject; ACol, ARow: Integer;
 Rect: TRect; State: TGridDrawState);
begin
 with Sender as TStringGrid do
 begin
   if (ACol > 1) and (ARow > 0) then
   begin
     Canvas.Font.Color := clBlack;
     if (ARow > 0) and (Odd(ARow)) then
       Canvas.Brush.Color := $00E1F7DF
     else
       Canvas.Brush.Color := clWhite;

     Canvas.TextRect(Rect, Rect.Left + 1, Rect.Top + 1, Cells[ACol, ARow]);
   end;
   if (ACol < 2) and (ARow > 0) then
   begin
     Canvas.Font.Color := clBlack;
     if Objects[0,ARow] = nil then
       Canvas.Brush.Color := $008CFFFF
     else
       Canvas.Brush.Color := clWhite;

     Canvas.TextRect(Rect, Rect.Left + 1, Rect.Top + 1, Cells[ACol, ARow]);
   end;
 end;
end;


---

← →
Игорь Шевченко ©   (2016-11-08 22:43) [1]

А Sender тот ?

---

← →
Некто   (2016-11-09 09:32) [2]

Да Sender тот. Да и я пробовал вместо Sender прямо имя вписывать StringGridMagazin.Objects.....
Хм. На смартфоне оказывается квадратных скобок нету.

---

← →
Некто   (2016-11-09 16:07) [3]

Вот так работает:


procedure Vergleichen(MagGrid, PrgGrid: TStringGrid);
const
 Zahl = [".","0".."9"];
var
 i,j,k: Integer;
 MagStr, PrgStr: string;
 Fund: Integer;
begin
 SetLength(MagZuNC,MagGrid.RowCount); //MagZuNC - динамический массив объявлен объявленный в глобальных переменных
 for i := 0 to Length(MagzuNC) - 1 do
   MagzuNC[i] := False;

 for i := 1 to MagGrid.RowCount - 1 do
 begin
   k := 1;
   MagStr := MagGrid.Cells[1,i];
   Fund := 0;
   while (k <= Length(MagStr)) do
   begin
     if (MagStr[k] = " ") then
       Inc(Fund);

     if (Fund > 2) then
     begin
       MagStr := Copy(MagStr,1,k-1);
       Break;
     end;

     Inc(k);
   end;
   for j := 1 to PrgGrid.RowCount - 1 do
   begin
     k := 1;
     PrgStr := PrgGrid.Cells[1,j];
     Fund := 0;
     while (k <= Length(PrgStr)) do
     begin
       if (PrgStr[k] = " ") then
         Inc(Fund);

       if (Fund > 2) then
       begin
         PrgStr := Copy(PrgStr,1,k-1);
         Break;
       end;

       Inc(k);
     end;
     if MagStr = PrgStr then
       //MagGrid.Objects[0,i] := Pointer(1)
       MagzuNC[i] := True;  // пишем сюда результаты сравнения двух StringGrid
     //else
       //MagGrid.Objects[0,i] := Pointer(0);

   end;
 end;

 MagGrid.Invalidate;
end;

procedure TForm1.StringGridMagazinDrawCell(Sender: TObject; ACol, ARow: Integer;
 Rect: TRect; State: TGridDrawState);
begin
 with {Sender as TStringGrid} StringGridMagazin do
 begin
   if (ACol > 1) and (ARow > 0) then
   begin
     Canvas.Font.Color := clBlack;
     if (ARow > 0) and (Odd(ARow)) then
       Canvas.Brush.Color := $00E1F7DF
     else
       Canvas.Brush.Color := clWhite;

     Canvas.TextRect(Rect, Rect.Left + 1, Rect.Top + 1, Cells[ACol, ARow]);
   end;
   if (ACol < 2) and (ARow > 0) then
   begin
     Canvas.Font.Color := clBlack;
     if (Length(MagzuNC) = RowCount) and not (MagzuNC[ARow]) then
     //if Objects[0,ARow] = nil then
       Canvas.Brush.Color := $008CFFFF
     else
       Canvas.Brush.Color := clWhite;
       
     Canvas.TextRect(Rect, Rect.Left + 1, Rect.Top + 1, Cells[ACol, ARow]);
   end;
 end;
end;


---

← →
Некто   (2016-11-09 16:20) [4]

А... Не заметил, что при копировании остался пробный вариант .
Здесь, в обработчике события работает так и так with {Sender as TStringGrid} StringGridMagazin do

---

← →
Некто   (2016-11-09 16:58) [5]

Для эксперимента в процедуре Vergleichen пишу и в динамический массив и в массив указателей-TObject:

     if MagStr = PrgStr then
     begin
       MagGrid.Objects[0,i] := Pointer(1);
       MagZuNC[i] := True;
     end
     else
       MagGrid.Objects[0,i] := Pointer(0);


В отладчике поставил две точки остановки:

     if (Length(MagZuNC) = RowCount) and not (MagZuNC[ARow]) then
       Canvas.Brush.Color := $008CFFFF     // Здесь
     else
       Canvas.Brush.Color := clWhite;        // И здесь


Слежу одновременно за значениями в дин. массиве и в StringGridMagazin.Objects[0,ARow] -
в Objects остаётся всегда nil и толькоиногда случайно не nil.

Совершенно не понимаю.
Может кто подскажет, где у меня напутано?

---

← →
Игорь Шевченко ©   (2016-11-09 16:59) [6]

Вот так - тоже работает

unit main;

interface

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

type
 TForm1 = class(TForm)
   Button1: TButton;
   StringGrid1: TStringGrid;
   procedure Button1Click(Sender: TObject);
   procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
     Rect: TRect; State: TGridDrawState);
 private
   procedure FillGrid;
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
 FillGrid;
end;

procedure TForm1.FillGrid;
var
 I: Integer;
begin
 with StringGrid1 do
 begin
   RowCount := 2 + Random(5);
   ColCount := 2 + Random(5);
   for I := 1 to Pred(RowCount) do
     if Random(10) > 5 then
       Objects[0, I] := TObject(1)
     else
       Objects[0, I] := TObject(0);
 end;
end;

procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
 Rect: TRect; State: TGridDrawState);
begin
 with Sender as TStringGrid do
 begin
   if not (gdFixed in State) then
     if Assigned(Objects[0,ARow]) then
       Canvas.Brush.Color := clRed;
   Canvas.FillRect(Rect);
   SetBkMode(Canvas.Handle, TRANSPARENT);
   DrawText(Canvas.Handle, PChar(IntToStr(ACol)+"*"+IntToStr(ARow)),-1,
     Rect, DT_SINGLELINE or DT_CENTER or DT_VCENTER);
 end;
end;

end.

Ищите у себя ошибку

---

← →
Некто   (2016-11-09 18:02) [7]

Игорь Шевченко ©   (09.11.16 16:59) [6]
 Спасибо.

Вставил ваш код - работает. У меня, практически тоже самое - не работает.
Чудеса думаю.

Однако, как оказалось чудес не бывает.
Логическая ошибка, как раз, здесь:

    if MagStr = PrgStr then
    begin
      MagGrid.Objects[0,i] := Pointer(1);
      MagZuNC[i] := True;
    end
    else
      MagGrid.Objects[0,i] := Pointer(0);

Во внутреннем цикле for j := 1 to PrgGrid.RowCount - 1 do
при следущем не совпадении значение просто переписывалось на ноль.
После первого совпадения нужно просто оборвать цикл
for j := 1 to PrgGrid.RowCount - 1 do

Поэтому с дин. массивом работало, а с Objects нет.

---

← →
Игорь Шевченко ©   (2016-11-09 18:46) [8]

Некто   (09.11.16 18:02) [7]

В большом коде всегда есть место для ошибки. Код должен быть небольшим, методы по 5-10 строк, и тестировать удобно.

---

← →
Германн ©   (2016-11-10 02:43) [9]

> Игорь Шевченко ©   (09.11.16 18:46) [8]
>
> Некто   (09.11.16 18:02) [7]
>
> В большом коде всегда есть место для ошибки. Код должен
> быть небольшим, методы по 5-10 строк, и тестировать удобно

Вообще-то говоря - чушь!
Если нормальный проект всегда нужно разбивать на процедуры/функции на 5-10 строк, то это геморрой ешё тот! Особенно при отладке.
Но это только моё имхо  как ПШП.

---

← →
Игорь Шевченко ©   (2016-11-10 10:20) [10]

Германн ©   (10.11.16 02:43) [9]

Промолчи ты хоть раз, дай отдохнуть фонтану.

---

← →
Германн ©   (2016-11-11 01:33) [11]

Стараюсь молчать в тематических конференциях твоими, Игорь, стараниями.
Но как представил себе код VCL разбитый на "процедуры/функции на 5-10 строк", то просто жуть охватила. Оно конечно VCL это не пользовательская программа. Но и советовать писать код пользовательской программы в таком стиле не есть хорошо.
Прими и прочь.

---

← →
Игорь Шевченко ©   (2016-11-11 10:16) [12]

> Но и советовать писать код пользовательской программы в
> таком стиле не есть хорошо.


Ну это же форум, посоветуй другое. Помоги найти ошибку автору.

---

← →
Германн ©   (2016-11-12 01:51) [13]

> Игорь Шевченко ©   (11.11.16 10:16) [12]
>
>
> > Но и советовать писать код пользовательской программы
> в
> > таком стиле не есть хорошо.
>
>
> Ну это же форум, посоветуй другое. Помоги найти ошибку автору.
>

Помогаю в меру сил и возможностей. Могу найти и часто нахожу ошибку/и особенно в тех случаях, когда автор выкладывает проект.

---

← →
Германн ©   (2016-11-12 02:02) [14]

Ну и вот совет по размеру кода процедур/функций я бы сформулировал так:
Старайтесь по возможности писать свои процедуры/функции так, чтобы их код можно было бы видеть целиком на экране монитора.
Ну а если не влезает, то попробуйте её разбить на две и больше. Но только в том случае, если такое разбиение будет оправдано логикой программы и здравым смыслом.

---

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

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

Наверх

Память: 0.52 MB
Время: 0.003 c