2009. augusztus 30., vasárnap

Create a multiple line heading in a TStringGrid


Problem/Question/Abstract:

How to create a multiple line heading in a TStringGrid

Answer:

Here is an example for a TStringGrid that has a multiple line heading with centered and bold text:

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;

Nincsenek megjegyzések:

Megjegyzés küldése