Question

我的程序应该从文本文件中读取数据，该文件用于在启动时设置不同单元格的颜色值。然而情况并非如此，因为细胞在启动时被涂成黑色，而不是所需的颜色。以下是我在文本文件中使用的值（＆＃39; Columns.txt＆＃39;）（*注意：16777215 / = white，32768 =绿色）：

Karel Bezuidenhoudt / 16777215/32768/16777215/16777215 / Jan Pieterse / 16777215/16777215/16777215/16777215 / Frik Bezuidenhoudt / 16777215/16777215/16777215/16777215 / Megan Smit / 16777215/16777215/16777215/16777215 /

Here is a screenshot of my main form

This is the output I am currently getting

相反，除第一行第二列中的单元格外，所有列都应为白色，如文本文件所示，该单元格应为绿色

当前代码如下（我为所有其他随机代码和变量道歉）：

 private
iHideAddPatient,iHideAddCol,iColumnCount,iGenerates,iChangeColor,MouseX,LeftPos,iColValue,iColorValue,iAddField,iShowHide,iPos,iLoopCount,iPatients,iRowOrder,iRowCount:Integer;
**sLine,sTextValues:string;**
**tColumns,tNames:TextFile;**
PnlTest0:TPanel;
PnlField,PnlFieldlbl,pnlPatient,PnlName:TPanel;
PnlColor,PnlColor2,PnlColor3,PnlColor4,PnlColor5,PnlColor6,PnlColor7:TPanel;
btnColor1:TButton;
arrNotes:array[1..400] of string;
arrFieldName:array[1..400] of string;
arrColumnName:array[1..400] of string;
arrColor:array[1..4] of Integer;
**arrNames:array[1..400] of string;**
**arrColCount:array[1..400] of Integer;**
arr2DColor:array[1..100,0..100] of Integer;

procedure GenerateField;
procedure DeleteDone;
procedure SortA;
procedure ChangeColor(k,l:Integer;paneltype:pnlType);
procedure ChangeColor1;
function CopyNext:string;
function FindPos:Integer;
function RemoveSpaces(sName:string):string;  



procedure TForm1.FormActivate(Sender: TObject);
var
  k,iRow,iCol:Integer;
  TheRect:TRect;
begin
pnlColomb.BringToFront;
pnlAddPatient.BringToFront;
pnlColomb.Visible:=False;
pnlAddPatient.Visible:=False;
StringGrid.ColWidths[0]:=200;
sTextValues:='/None/Not received/Received/Analysed/0/';
redtTest.lines.Clear;
iHideAddPatient:=0;
iHideAddCol:=0;
iLoopCount:=1;
iPatients:=0;
iRowCount:=0;
iColumnCount:=0;
iShowHide:=0;
AssignFile(tColumns,'Columns.txt');
 //Append(tColumns);
 try
  Reset(tColumns);
  except
  Showmessage('Textfile missing') ;
  Exit;
  end;
while not Eof(tColumns) do
begin
  Inc(iColumnCount);
  Readln(tColumns,sLine);
  if sLine=''
  then
  begin
  CloseFile(tColumns)
  end
  else
  begin
  arrColumnName[iColumnCount]:=CopyNext;
  DeleteDone;
  end;
end;
CloseFile(tColumns);

AssignFile(tNames,'Patients.txt');

try
  Reset(tNames);
  except
    ShowMessage('Patients.txt doesn''t exist');
  Exit;
  end;

  while not Eof(tNames) do
begin
  Inc(iPatients);
  Readln(tNames,sLine);

  arrNames[iPatients]:=CopyNext;
  DeleteDone;

  for k:=1 to iColumnCount do
  begin
    arr2DColor[iPatients,k]:=StrToInt(CopyNext);
    //ShowMessage(IntToStr(iPatients)+':'+IntToStr(k)+' = '+inttostr(arr2DColor[iPatients,k]));
    DeleteDone;
  end;
  redtTest.Lines.Add('Name:'+IntToStr(iPatients)+' '+arrNames[iPatients]);

  end;


for iRow := 1 to iPatients do
  begin
    for iCol := 1 to iColumnCount do
    begin
      StringGrid.Canvas.Brush.Color:=arr2DColor[iRow,iCol];
      TheRect:=StringGrid.CellRect(iCol,iRow);
      StringGrid.Canvas.FillRect(TheRect);
      StringGrid.Cells[0,iRow]:=arrNames[iRow];
      StringGrid.Cells[iCol,0]:=arrColumnName[iCol];
end;

end;

end;
procedure TForm1.btnAddClick(Sender: TObject);
begin
   if iShowHide=0 then
   begin
    pnlColomb.Visible:=True;
      iShowHide:=1;
   end
  else
   begin
    pnlColomb.Visible:=False;
    iShowHide:=0;
   end;
end;
procedure TForm1.DeleteDone;
begin
   Delete(sLine,1,FindPos);
end;

function TForm1.FindPos: Integer;
begin
   Result:=Pos('/',sLine);
end;


function TForm1.CopyNext: string;
begin
  Result:=Copy(sLine,1,FindPos-1);
end;

当我点击它们时，我用来改变单元格颜色的代码如下（我相信我复制了所有必要的代码，但如果有什么东西似乎缺失，请告诉我）：

procedure TForm1.StringGridDrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
const
  clOrange = TColor($008CFF);
  CellColors: array[0..3] of TColor = (16777215, clRed, clOrange, clGreen);
begin
  if (ACol in [1..iColumnCount]) and (ARow in [1..iPatients]) then
  begin
    StringGrid.Canvas.Brush.Color := CellColors[arr2Dcolor[ARow, ACol]];
    StringGrid.Canvas.FillRect(Rect);
  end;
end;

type
  TStringGridAccess = class(TStringGrid)
  end;


procedure TForm1.StringGridSelectCell(Sender: TObject; ACol, ARow: Integer;
  var CanSelect: Boolean);
begin
  if (ACol in [1..iColumnCount]) and (ARow in [1..iPatients]) then
  begin
    arr2DColor[ARow, ACol] := (arr2dColor[ARow, ACol] + 1) mod 4;
    TStringGridAccess(StringGrid).InvalidateCell(ACol, ARow);
  end;
 if (ACol=0) and (ARow>0) then
  begin
    ShowMessage(arrNotes[ARow]);
    TStringGridAccess(StringGrid).InvalidateCell(ACol, ARow);
  end;
  end;

Answer 1

好吧我明白了。感谢所有指出逻辑错误的人！是的My Columns必须从iCols = 0开始，直到iColumnCount-1与iRows相同。此外，在我设置2D颜色的地方，我必须将其更改为以下内容：

arr2DColor[iPatients,k+1]:=StrToInt(CopyNext);

在我为iCol = 0和iRow = 0设置文本的地方我改变了如下：

StringGrid.Cells[0,iRow+1]:=arrNames[iRow];
StringGrid.Cells[iCol+1,0]:=arrColumnName[iCol];

同样arrColors，应该有1,2或3的值（而不是颜色的int值）作为参数from arrColors从该参数中选择颜色，所以我不得不将文本文件更改为如下：

Karel Bezuidenhoudt / 1/2/0/0 / Jan Pieterse / 0/0/0/0 / Frik Bezuidenhoudt / 0/0/0/0 / Megan Smit / 0/1/2/3 /

OnDrawCell的代码如下

procedure TForm1.StringGridDrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
const
  clOrange = TColor($008CFF);
  CellColors: array[0..3] of TColor = (clWhite, clRed, clOrange, clGreen);
begin
  if (ACol in [1..iColumnCount]) and (ARow in [1..iPatients]) then
  begin
    StringGrid.Canvas.Brush.Color := CellColors[arr2Dcolor[ARow, ACol]];
    StringGrid.Canvas.FillRect(Rect);
  end;
end;

再次非常感谢您的反馈！

Delphi 7：StringGrid DrawCell事件在启动时将所有单元格着色为黑色

1 个答案: