Ciao,
io uso questa qui sotto. Basta mettere LineEnding dove vuiu che vada a capo.
Ci pensa da sola a variare l'altezza della cella.
P.S. Cancella la parte di codice relativa alla booleana "VFSistemaColori", serve a me per una gestione particolare.
Ciao, Mario
{Permette di scrivere una cella su più righe tramite l'utilizzo del LineEnding.
Aggiungere il richiamo della presente "procedure" all'interno della "DrawCell"}
procedure ScriviCellaSuPiuRighe(Sender:TObject; aCol, aRow:Integer; aRect:TRect; VFSistemaColori:Boolean = True);
var WrkStr:String;
DrawRect:TRect;
procedure SetGridHeight(const WrkGrid: TStringGrid);
var Counter, NewHeight: Integer;
begin
NewHeight:=0;
with WrkGrid do begin
for Counter:=0 to RowCount - 1 do begin
NewHeight:=NewHeight +
RowHeights[Counter] +
GridLineWidth;
end;
ClientHeight:=NewHeight -
GridLineWidth;
end;
end;
begin
with (Sender as tStringGrid), Canvas do begin
{ erase earlier contents from default drawing }
if VFSistemaColori then begin
if (aRow >= FixedRows) and (aCol >= FixedCols) then begin
//Se la riga è selezionata, e tra le opzioni della tabella
//c'è la selezione per riga, cambio il colore dello sfondo
if (aRow = Row) and (goRowSelect in Options) then begin
Brush.Color:=SelectedColor;
Font.Color:=clWhite;
end else begin
Brush.Color:=Color;
Font.Color:=clWindowText;
end;
end else begin
Brush.Color:=FixedColor;
Font.Color:=clWindowText;
end;
end;
FillRect(aRect);
{ get cell contents }
WrkStr:=Cells[aCol, aRow];
if Length(WrkStr) > 0 then begin
{ copy of cell rectangle for text sizing }
DrawRect:=aRect;
if (Pos(LineEnding, WrkStr) > 0) then begin
//Se la riga da emettere contiene "LineEnding", riformatto la cella
{ get size of text rectangle in DrawRect, with word wrap }
DrawText(Handle, PChar(WrkStr), Length(WrkStr), DrawRect, DT_CALCRECT or DT_WORDBREAK or DT_CENTER);
if ((DrawRect.Bottom - DrawRect.Top) > RowHeights[aRow]) then begin
{ cell word-wraps; increase row height }
RowHeights[aRow]:=DrawRect.Bottom - DrawRect.Top;
{$IFDEF LINUX}
//Su Linux, senza l'istruzione qui sotto, la cosa funzionerebbe solo
//dopo aver cliccato su una cella qualsiasi della riga
(Sender as TStringGrid).Repaint;
{$ENDIF}
end else begin
{ cell doesn't word-wrap }
DrawRect.Right:=aRect.Right;
FillRect(DrawRect);
DrawText(Handle, PChar(WrkStr), Length(WrkStr), DrawRect, DT_WORDBREAK);
end;
end else begin
//La cella da emettere non contiene "LineEnding": scrivo direttamente
DrawText(Handle, PChar(WrkStr), Length(WrkStr), DrawRect, DT_SINGLELINE or DT_VCENTER);
end;
end;
end;
end;
Ho fatto una prova veloce.
Se modifichi questa riga:
if ((DrawRect.Bottom - DrawRect.Top) > RowHeights[aRow]) then begin
facendola diventare così:
if ((DrawRect.Bottom - DrawRect.Top) <> RowHeights[aRow]) then begin
Dovrebbe funzionare.
Ciao, Mario
Io la prova l'ho fatta così:
- ho messo il richiamo alla procedura nella "OnDrawCell" della Stringgrid
- ho messo nel form 2 bottoni.
- in un bottone c'è l'istruzione "StringGrid1.Font.Size:=8;"
- nell'altro bottone c'è l'istruzione "StringGrid1.Font.Size:=20;"
- nella StringGrid, ho compilato solo una cella con questo:
StringGrid1.Cells[1,1]:='Riga1' +
LineEnding +
'Riga2' +
LineEnding +
'Riga3' +
LineEnding +
'Riga4' +
LineEnding;
Faccio partire il programma e, cliccando alternativamente sui 2 bottoni, la riga mi viene ridimensionata correttamente.
P.S. Sto facendo le prove su un PC con Windows 10
Ciao, Mario