Многострочные ячейки в StringGrid.

Материал из DRKB

Многострочные ячейки в StringGrid.[править | править код]

Сперва необходимо установить свойство DefaultDrawing в False. Далее, необходимо вставить следующий код в обработчик события OnDrawCell:

procedure TForm1.StringGrid1DrawCell(Sender: TObject;
  Col, Row: Longint;
  Rect: TRect;
  State: TGridDrawState);
var
  Line1: string;
  Line2: string;
  ptr: integer;
  padding: integer;
  hGrid: TStringGrid;
begin
  hGrid := (Sender as TStringGrid);
  ptr := Pos(';', hGrid.Cells[Col, Row]);
  if ptr > 0 then
  begin
    Line1 := Copy(hGrid.Cells[Col, Row], 1, ptr - 1);
    Line2 := Copy(hGrid.Cells[Col, Row], ptr + 1,
      Length(hGrid1.Cells[Col,Row]) - ptr);
  end
  else
    Line1 := hGrid.Cells[Col, Row];
  hGrid.Canvas.FillRect(Rect);
  hGrid.Canvas.TextOut(Rect.Left, Rect.Top + 2, Line1);
  if ptr > 0 then
    hGrid.Canvas.TextOut(Rect.Left, Rect.Top -
      hGrid.Canvas.Font.Height + 3, Line2);
end;


Теперь достаточно для переноса строки вставить в неё точку с запятой. Так же не забудьте изменить высоту строки так, чтобы переносы строки поместились в ячейку:

 StringGrid1.RowHeights[0] := StringGrid1.DefaultRowHeight * 2 ;


Source: Взято из http://forum.sources.ru
ID: 00606



Ниже приведен пример, делающий заголовок многострочным, центрированным и с жирным шрифтом:


// if Dispatch.GetIDsOfNames(GUID_NULL, @NameRefs, NameCount,

procedure TForm1.grid1DrawCell(Sender: TObject; Col, Row: Longint;
  Rect: TRect; State: TGridDrawState);
var
  l_oldalign: word;
  l_YPos, l_XPos, i: integer;
  s, s1: string;
  l_col, l_row: longint;
begin
  l_col := col;
  l_row := row;
  with sender as TStringGrid do
  begin
    if (l_row = 0) then
      Canvas.Font.Style := Canvas.Font.Style + [fsbold];
    if l_row = 0 then
    begin
      l_oldalign := SetTextAlign(Canvas.Handle, ta_center);
      l_XPos := Rect.Left + (Rect.Right - Rect.Left) div 2;
      s := Cells[l_col, l_row];
      while s <> '' do
      begin
        if Pos(#13, s) <> 0 then
        begin
          if Pos(#13, s) = 1 then
            s1 := ''
          else
          begin
            s1 := Trim(Copy(s, 1, Pred(Pos(#13, s))));
            Delete(s, 1, Pred(Pos(#13, s)));
          end;
          Delete(s, 1, 2);
        end
        else
        begin
          s1 := Trim(s);
          s := '';
        end;
        l_YPos := Rect.Top + 2;
        Canvas.TextRect(Rect, l_Xpos, l_YPos, s1);
        Inc(Rect.Top, RowHeights[l_row] div 3);
      end;
      SetTextAlign(Canvas.Handle, l_oldalign);
    end
    else
    begin
      Canvas.TextRect(Rect, Rect.Left + 2, Rect.Top + 2, Cells[l_col, l_row]);
    end;

    Canvas.Font.Style := Canvas.Font.Style - [fsbold];
  end;
end;


Source: http://delphiworld.narod.ru/
ID: 01085



procedure TForm1.grid1DrawCell(Sender: TObject; Col, Row: Longint;
  Rect: TRect; State: TGridDrawState);
var
  l_oldalign: word;
  l_YPos, l_XPos, i: integer;
  s, s1: string;
  l_col, l_row: longint;
begin
  l_col := col;
  l_row := row;
  with sender as tstringgrid do
  begin
    if (l_row=0) then
      Canvas.Font.Style := Canvas.Font.Style + [fsbold];
    if l_row=0 then
    begin
      l_oldalign := SetTextAlign(Canvas.Handle, ta_center);
      l_XPos := Rect.Left + (Rect.Right - Rect.Left) div 2;
      s := Cells[l_col, l_row];
      while s <> '' do
      begin
        if Pos(#13, s) <> 0 then
        begin
          if Pos(#13, s) = 1 then
            s1 := ''
          else
          begin
            s1 := Trim(Copy(s, 1, Pred(Pos(#13, s))));
            Delete(s, 1, Pred(Pos(#13, s)));
          end;
          Delete(s, 1, 2);
        end
        else
        begin
          s1 := Trim(s);
          s := '';
        end;
        l_YPos := Rect.Top + 2;
        Canvas.TextRect(Rect, l_Xpos, l_YPos, s1);
        Inc(Rect.Top, RowHeights[l_row] div 3);
      end;
      SetTextAlign(Canvas.Handle, l_oldalign);
    end
    else
    begin
      Canvas.TextRect(Rect, Rect.Left + 2, Rect.Top + 2, Cells[l_col, l_row]);
    end;
    Canvas.Font.Style := Canvas.Font.Style - [fsbold];
  end;
end;


Source: http://delphiworld.narod.ru/
ID: 01086



Была необходимость в использовании многострочного TStringGrida. Не один из трех способов создания не сработал, Переработал статью о подобной проблеме с TDBGridом. Получилось нечто очень компактное, чем и решил поделиться. Обработка того же события прорисовки, в uses надо добавить WinProcs:

procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow:
  Integer;
  Rect: TRect; State: TGridDrawState);
var
  Format: Word;
  C: array[0..255] of Char;
begin
  Format := DT_LEFT or DT_WORDBREAK;
  (Sender as TStringGrid).Canvas.FillRect(Rect);
  StrPCopy(C, (Sender as TStringGrid).Cells[ACol, ARow]);
  WinProcs.DrawText((Sender as TStringGrid).Canvas.Handle, C,
    StrLen(C), Rect, Format);
end;


Source: http://delphiworld.narod.ru/
ID: 01087