Отрисовка ячеек StringGrid

@lexasf · Регистрация: 30.09.2010

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

Приветствую! Столкнулся с проблемой при динамическом создании StringGrid-ov. Ячейки почему-то отрисовываются в самом последнем, из созданных, а если переключится на предыдущий ( они создаются на вкладках pagecontrol), то все ячейки опять стандартного цвета. Как можно исправить эту проблему?

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
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
type
  TForm3 = class(TForm)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    ListView1: TListView;
    Image1: TImage;
    Procedure  ButClick(Sender: TObject);
    procedure ListView1DblClick(Sender: TObject);
    Procedure sGridDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
  private
  public
  end;
 
var
  Form3: TForm3;
  n,s,k:integer;
  TabSheet: array of TTabSheet;
  But:TBitBtn;
  Sgrid:TStringGrid;
 
Procedure  TForm3.ButClick(Sender: TObject);
var Active:Integer;
Begin
   with PageControl1 do
      Begin
         Active:=PageControl1.ActivePageIndex;
         Pages[Active].Destroy;
         PageControl1.ActivePage:=TabSheet[Active-1];
      End;
   SetLength(TabSheet,n-1);
end;
 
procedure TForm3.sGridDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
var
  I: Integer;
Begin;
     if sGrid.Cells[Acol,ARow]='5' then
  begin
    sgrid.Canvas.Brush.Color := $0077FD99;   
    sgrid.Canvas.FillRect (Rect);
    sgrid.Canvas.TextRect (Rect, Rect.Left + 2, Rect.Top + 2, sgrid.Cells[ACol,ARow]);
  end;
 
  if sGrid.Cells[Acol,ARow]='4' then
  begin
    sgrid.Canvas.Brush.Color := $0077FAFD;   
    sgrid.Canvas.FillRect (Rect);
    sgrid.Canvas.TextRect (Rect, Rect.Left + 2, Rect.Top + 2, sgrid.Cells[ACol,ARow]);
  end;
 
  if sGrid.Cells[Acol,ARow]='3' then
  begin
    sgrid.Canvas.Brush.Color := $00758AFF;    
    sgrid.Canvas.FillRect (Rect);
    sgrid.Canvas.TextRect (Rect, Rect.Left + 2, Rect.Top + 2, sgrid.Cells[ACol,ARow]);
  end;
  SetBkMode(Handle, TRANSPARENT);
end;
 
procedure TForm3.ListView1DblClick(Sender: TObject);
   var
      BMP:TPNGImage;
      b:TBitMap;
      ItmIdx,i,j:Integer;
      Rect:TRect;
      Text:String;
      But:TBitBtn;
begin
  ItmIdx:=Listview1.ItemIndex;
  if ItmIdx=-1 then Exit;
  for I := 0 to n-1 do
    Begin
      if Tabsheet[i].Caption=Listview1.Items.Item[itmIdx].Caption+' '+ Listview1.Items.Item[itmidx].SubItems[0] then
      begin
       exit;
      end;
 
    End;
 
  {****Create TabSheet****}
 
  n:=Length(TabSheet)+1;
  SetLength(TabSheet,n);
  TabSheet[n-1]:=TTabSheet.Create(self); //создать вкладку, n-1 
  TabSheet[n-1].Caption:=Listview1.Items.Item[itmIdx].Caption+' '+ Listview1.Items.Item[itmidx].SubItems[0];
  TabSheet[n-1].PageControl:=PageControl1;
  PageControl1.ActivePage:=TabSheet[n-1]; //сделать активной
 
 
  {****Create Button****}
 
  But:=TBitBtn.Create(Self);
  But.Parent:=TabSheet[n-1] ;
  But.left:=TabSheet[n-1].Width-45;
  But.Top:=10;
  But.OnClick:=ButClick;
  BMP:= TPNGImage.Create;
  B:=TBitMap.Create;
  BMP.LoadFromFile('C:\Users\Lexa\desktop\exit2.png');
  b.Assign(BMP);
  But.Glyph:=b;
  But.Width:=b.Width+1;
  But.Height:=But.Height+5;
  BMP.free;
  b.Free;
 
  {****Create List****}
 
  Sgrid:=TStringGrid.Create(Self);
  sGrid.Name:='sGrid'+Inttostr(n-1);
  Sgrid.Parent:=TabSheet[n-1];
  sGrid.OnDrawCell:=SGridDrawCell;
  Sgrid.Width:=Listview1.Width div 2 + 16;
  Sgrid.Height:=Listview1.Height div 2 + 89;
  Sgrid.Left:=Listview1.Left+160;
  Sgrid.Top:=Listview1.top+50;
  Sgrid.Visible:=True;
  Sgrid.ColCount:=7;
  SGrid.RowCount:=13;
 
  {****Add Cols&Rows****}
 
  with sGrid do
     Begin
       Cols[1].Text:='I';
       Cols[2].Text:='II';
       Cols[3].Text:='III';
       Cols[4].Text:='IV';
       Cols[5].Text:='I+II';
       Cols[6].Text:='III+IV';
       Cols[7].Text:='YEAR';
       Rows[1].Text:='Русский язык';
       Rows[2].Text:='Литература';
       Rows[3].Text:='Обществознание';
       Rows[4].Text:='История';
       Rows[5].Text:='Физика';
       Rows[6].Text:='Химия';
       Rows[7].Text:='Биология';
       Rows[8].Text:='Физкультура';
       Rows[9].Text:='Информатика';
       Rows[10].Text:='Математика';
       Rows[11].Text:='Геометрия';
       Rows[12].Text:='Башкириский';
     End;
         
      {****Тестовые значения для проверки****}     
 
       sGrid.Cells[2,3]:='5';
       sGrid.Cells[2,5]:='3';
       sGrid.Cells[2,4]:='4';
       sGrid.Cells[3,3]:='5';
       sGrid.Cells[4,5]:='3';
       sGrid.Cells[5,4]:='4';
 
       for i := 0 to SGrid.Colcount-1 do
          Begin
            if i=0 then sGrid.ColWidths[i]:=91 Else sGrid.ColWidths[i]:=40
          End;
 
       for I := 0 to sgrid.Rowcount - 1 do
         Begin
           sGrid.RowHeights[i]:=20;
         End;
end;
 
end.

@volvo · 11.11.2012, 12:52

А не надо привязываться в процедуре отрисовки к конкретному имени. Для этого есть Sender:

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
procedure TForm3.sGridDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
var
  I: Integer;
  sGrid : TStringGrid; // <---
Begin;
  sGrid := Sender as TStringGrid; // <--- теперь будешь работать с тем гридом, который передан через Sender
 
     if sGrid.Cells[Acol,ARow]='5' then
  begin
    sgrid.Canvas.Brush.Color := $0077FD99;   
    sgrid.Canvas.FillRect (Rect);
    sgrid.Canvas.TextRect (Rect, Rect.Left + 2, Rect.Top + 2, sgrid.Cells[ACol,ARow]);
  end;
 
  if sGrid.Cells[Acol,ARow]='4' then
  begin
    sgrid.Canvas.Brush.Color := $0077FAFD;   
    sgrid.Canvas.FillRect (Rect);
    sgrid.Canvas.TextRect (Rect, Rect.Left + 2, Rect.Top + 2, sgrid.Cells[ACol,ARow]);
  end;
 
  if sGrid.Cells[Acol,ARow]='3' then
  begin
    sgrid.Canvas.Brush.Color := $00758AFF;    
    sgrid.Canvas.FillRect (Rect);
    sgrid.Canvas.TextRect (Rect, Rect.Left + 2, Rect.Top + 2, sgrid.Cells[ACol,ARow]);
  end;
  SetBkMode(Handle, TRANSPARENT);
end;

@lexasf · 11.11.2012, 16:08 **[ТС]**

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

А не надо привязываться в процедуре отрисовки к конкретному имени. Для этого есть Sender:

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
procedure TForm3.sGridDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
var
  I: Integer;
  sGrid : TStringGrid; // <---
Begin;
  sGrid := Sender as TStringGrid; // <--- теперь будешь работать с тем гридом, который передан через Sender
 
     if sGrid.Cells[Acol,ARow]='5' then
  begin
    sgrid.Canvas.Brush.Color := $0077FD99;   
    sgrid.Canvas.FillRect (Rect);
    sgrid.Canvas.TextRect (Rect, Rect.Left + 2, Rect.Top + 2, sgrid.Cells[ACol,ARow]);
  end;
 
  if sGrid.Cells[Acol,ARow]='4' then
  begin
    sgrid.Canvas.Brush.Color := $0077FAFD;   
    sgrid.Canvas.FillRect (Rect);
    sgrid.Canvas.TextRect (Rect, Rect.Left + 2, Rect.Top + 2, sgrid.Cells[ACol,ARow]);
  end;
 
  if sGrid.Cells[Acol,ARow]='3' then
  begin
    sgrid.Canvas.Brush.Color := $00758AFF;    
    sgrid.Canvas.FillRect (Rect);
    sgrid.Canvas.TextRect (Rect, Rect.Left + 2, Rect.Top + 2, sgrid.Cells[ACol,ARow]);
  end;
  SetBkMode(Handle, TRANSPARENT);
end;

Помогло, спасибо большое!

Новые блоги и статьи Все статьи Все блоги /
Использование Keycloak со Spring Boot и интеграция Identity Provider Javaican 01.07.2025 Два года назад я получил задачу, которая сначала показалась тривиальной: интегрировать корпоративную аутентификацию в микросервисную архитектуру. На тот момент у нас было семь Spring Boot приложений,. . .	Содержание темы с примерами на WebGL 8Observer8 01.07.2025 Все примеры из книги Мацуды и Ли в песочнице JSFiddle Пример выводит точку красного цвета размером 10 пикселей на WebGL 1. 0 и 2. 0 WebGL 1. 0. Передача координаты точки из главной программы в. . .	Основы WebGL. Простой треугольник 8Observer8 01.07.2025 Простой треугольник без трансформаций. Для трансформаций можно использовать glMatrix, как в примере: https:/ / plnkr. co/ edit/ qT6ZTwvncLPRamK5?preview На русском: . . .	Полиглотные микросервисы на C# и .NET ArchitectMsa 30.06.2025 Полиглотная архитектура появилась не из желания усложнить жизнь разработчикам. Она родилась из практической необходимости решать разные задачи наиболее эффективным способом. В одном из проектов. . .	Стратегии кеширования Javaican 29.06.2025 Кеширование — это хранение часто запрашиваемых данных в быстром хранилище (обычно в памяти), чтобы не обращаться к более медленному первоисточнику. Казалось бы, все просто. Но за этой простотой. . .
Наблюдаемость приложений ASP.NET Core с OpenTelemetry, Prometheus и Grafana ArchitectMsa 29.06.2025 Наблюдаемость (observability) – это ключевое свойство современной системы, позволяющее понимать её внутреннее состояние на основе внешних данных. Если мониторинг отвечает на вопрос "что случилось?",. . .	Четыре главных модели отношений классов в с++ russiannick 28.06.2025 Продолжаю крестовый поход против c++. ideone. com/ юзаю для проверки валидности кода. Насчитал 4 модели отношений классов: одиночный класс, равноправные классы, слейв - мастер, терминатор. . . .	Вложенные корутины в Unity GameUnited 28.06.2025 Работа с корутинами в Unity кажется простой до тех пор, пока не начинаешь их вкладывать друг в друга. Я потратил несколько месяцев на изучение этого механизма, и до сих пор иногда ловлю себя на том,. . .	Управление Arduino на C# через последовательный порт Wired 28.06.2025 Когда я впервые попробовал заставить Arduino общаться с моим C# приложением, казалось, что эти два мира существуют параллельно и никогда не пересекутся. Микроконтроллер упорно моргал встроенным. . .	Основы OpenGL 3.3 и Qt 6.9. Трансформированный треугольник 8Observer8 27.06.2025 Содержание блога На русском https:/ / rutube. ru/ video/ e424497dd6b7ae7e11494027c4b31a54/ https:/ / vkvideo. ru/ video-231040171_456239019 https:/ / www. youtube. com/ watch?v=mfD-ZL7wa_4