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



我的程序应该从文本文件中读取数据,该文本文件用于设置启动时不同单元格的颜色值。然而,情况并非如此,因为单元格在启动时是黑色的,而不是所需的颜色。以下是我在textfile('Columns.txt')中使用的值(*注:16777215/=白色,32768=绿色):

卡雷尔Bezuidenhoudt/16777215/32768/16777215/16777215/Jan Pieterse/16777215/16777215/16777215/16777215/Frik Bezuidenhoudt/16777215/16777215/16777215/16777215/梅根Smit/16777215/16777215/16777215/16777215/

这是我的主表单的截图

这是我当前得到的输出

所有的列都应该是白色的,除了第一行第二列的单元格,它应该是绿色的,正如textfile

所指示的那样

当前代码如下(我为所有其他随机代码和变量道歉):

 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;

好吧,我明白了。感谢所有指出逻辑错误的人!是的,我的列必须在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值)作为参数,arrColors从该参数中选择颜色,所以我必须改变文本文件如下:

卡雷尔Bezuidenhoudt/1/2/0/0/Jan Pieterse/0/0/0/0/Frik Bezuidenhoudt/0/0/0/0/梅根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;

再次感谢您的反馈!

最新更新