Top.Mail.Ru
Мастера DELPHI, Delphi programming community Титульная страница Поиск, карта сайта Написать письмо 
| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL |
| Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

форум | следующая ветвь »

StringGrid.Objects


Некто ©   (2016-11-08 19:01:00) 

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-12 02:02:00) [1]

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

Германн   (2016-11-12 01:51:00) [2]


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

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

Игорь Шевченко   (2016-11-11 10:16:00) [3]


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


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

Германн   (2016-11-11 01:33:00) [4]

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

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

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

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

Германн   (2016-11-10 02:43:00) [6]


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

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

Игорь Шевченко   (2016-11-09 18:46:00) [7]

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

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

Некто   (2016-11-09 18:02:00) [8]

Игорь Шевченко ©   (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 16:59:00) [9]

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

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 16:58:00) [10]

Для эксперимента в процедуре 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:20:00) [11]

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

Некто   (2016-11-09 16:07:00) [12]

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


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 09:32:00) [13]

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

Игорь Шевченко   (2016-11-08 22:43:00) [14]

А Sender тот ?

Наверх

Титульная страница Поиск, карта сайта Написать письмо