Stringgrid

[triamera977]

Всем привет. помогите пожалуйста разобраться с задачей. Есть таблица стрингрид, в ней нужно закрасить ячейки.

procedure TForm1.AdvStringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
  var
        x:Integer;
        y:Integer;
begin
x:=1;
y:=0;
AdvStringGrid1.Canvas.Brush.Color:=clRed;
while (x <> 100) and (y <> 100) do
begin
x:=x+1;
y:=y+1;

if ((ACol=x) and (ARow=y))   then
AdvStringGrid1.Canvas.FillRect(Rect);

if ((ACol=x) and (ARow=y+1))  then
AdvStringGrid1.Canvas.FillRect(Rect);

  end;
end;

Получается как изображено на картинке no.png , а надо чтоб получилось как на картинке уеs.png

 

[Sascha]

а в чём разница между картинками?

 

[Sascha]

всё понял с первого взгляда одинаковыеRauchend

 

[Sascha]

begin
x:=1;
y:=-1;
AdvStringGrid1.Canvas.Brush.Color:=clRed;
while (x <> 100) and (y <> 100) do
begin
x:=x+1;
y:=y+2;

if ((ACol=x) and (ARow=y))   then
AdvStringGrid1.Canvas.FillRect(Rect);

if ((ACol=x) and (ARow=y+1))  then
AdvStringGrid1.Canvas.FillRect(Rect);

  end;
end;

 

[Sascha]

Вот пример другой может пригодится

type
  TStatusColor = class
  public
    Code: integer;
    Name: string;
    Color: TColor;
  end;


type

  { TForm1 }

  TForm1 = class(TForm)
    AdvStringGrid1: TAdvStringGrid;
    procedure AdvStringGrid1ShowHint(Sender: TObject; HintInfo: PHintInfo);
    procedure FormCreate(Sender: TObject);
    procedure AdvStringGrid1DrawCell(Sender: TObject; aCol, aRow: integer;
      aRect: TRect; aState: TGridDrawState);
    procedure FormDestroy(Sender: TObject);
    procedure AdvStringGrid1Click(Sender: TObject);
  private
    { private declarations }
    lstStatuses: TStringList;
    procedure addStatusColor(aCode: integer; aName: string; aColor: TColor);
  public
    { public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TForm1 }

procedure TForm1.AdvStringGrid1Click(Sender: TObject);
begin
AdvStringGrid1.EditMode.ToInteger;
end;

procedure TForm1.AdvStringGrid1DrawCell(Sender: TObject; aCol, aRow: integer;
  aRect: TRect; aState: TGridDrawState);
var
  iStIdx: integer;
begin
  if Length(Trim(AdvStringGrid1.Cells[ACol, ARow])) > 0 then
  begin
    iStIdx := lstStatuses.IndexOf(AdvStringGrid1.Cells[ACol, ARow]);
    if iStIdx >= 0 then
    begin
      AdvStringGrid1.Canvas.Brush.Color :=
        (lstStatuses.Objects[iStIdx] as TStatusColor).Color;

      AdvStringGrid1.Canvas.FillRect(aRect);
      AdvStringGrid1.Canvas.TextRect(aRect, aRect.Left + 2, aRect.Top + 2,
        AdvStringGrid1.Cells[ACol, ARow]);
    end;
  end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
var
  i: integer;
  scStatus: TStatusColor;
begin
  for i := 0 to lstStatuses.Count - 1 do
  begin
    try
      scStatus := lstStatuses.Objects[i] as TStatusColor;
      FreeAndNil(scStatus);
    finally
    end;
  end;
  lstStatuses.Clear;
  lstStatuses.Free;
end;

procedure TForm1.addStatusColor(aCode: integer; aName: string; aColor: TColor);
var
  scStatus: TStatusColor;
begin
  scStatus := TStatusColor.Create;
  scStatus.Code := aCode;
  scStatus.Name := aName;
  scStatus.Color := aColor;

  lstStatuses.AddObject(IntToStr(aCode), scStatus);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  lstStatuses := TStringList.Create;
  lstStatuses.Sorted := False;

  addStatusColor(1, 'Болен', TColor($008080FF));
  addStatusColor(6, 'В отпуске', TColor($00B3FFFF));
  addStatusColor(7, 'Командировка', TColor($00BFBFFF));
  addStatusColor(8, 'Был', clRed);
  addStatusColor(2, 'Болен', TColor(clMoneyGreen));

  lstStatuses.Sorted := True;

  AdvStringGrid1.Cells[1, 1] := '8';
  AdvStringGrid1.Cells[1, 2] := '1';
  AdvStringGrid1.Cells[1, 3] := '6';
  AdvStringGrid1.Cells[3, 4] := '7';
  AdvStringGrid1.Cells[3, 3] := '2';
  AdvStringGrid1.Cells[4, 1] := '8';
  AdvStringGrid1.Cells[5, 2] := '1';
  AdvStringGrid1.Cells[6, 3] := '6';
  AdvStringGrid1.Cells[7, 4] := '7';
  AdvStringGrid1.Cells[8, 3] := '2';
end;

procedure TForm1.AdvStringGrid1ShowHint(Sender: TObject; HintInfo: PHintInfo);
var
  iRow, iCol: integer;
  iStIdx: integer;
begin
  AdvStringGrid1.MouseToCell(HintInfo^.CursorPos.X, HintInfo^.CursorPos.Y, iCol, iRow);
  if (Length(Trim(AdvStringGrid1.Cells[iCol, iRow])) > 0) and
    (iCol > 0) and (iRow > 0) then
  begin
    iStIdx := lstStatuses.IndexOf(AdvStringGrid1.Cells[iCol, iRow]);
    if iStIdx >= 0 then
      HintInfo^.HintStr :=
        (lstStatuses.Objects[iStIdx] as TStatusColor).Name
    else
      HintInfo^.HintStr := 'Не указано!!!';
  end;
end;

 

[triamera977]

спасибо!

 

[triamera977]

хочу вот такую штуку сделать, только без перемешки сотрудников
View: https://www.youtube.com/watch?v=fSE_Pi2VNWo

пока сделал так

 

[Sascha]

ну почти готовая прога

 

[triamera977]

ага, осталось за малым :), вывести диапазон дат месяца и по возможности добавлять выходные(праздничные) дни

 

[BITru]

while не используй иначе греха не оберешься DrawCell и так работает в цикле это может привести к краху приложения.