Stringgrid multilinea... dimensione cella: com fare?

[Narciso]

La stringgrid di lazarus puo' far diventare una cella multilinea... agendo sull'onpreparecanvas....

Ma come si fa a ridimensionare le celle in modo tale da far vedere tutto il contenuto?



procedure TForm1.BitBtn1Click(Sender: TObject);
var c,r:integer;
begin
for c:= 0 to stringgrid1.colcount-1 do
for r:= 0 to stringgrid1.rowcount-1 do
stringgrid1.cells[c,r]:='12345678901'+#13#10+'234567890'+#13#10+'234567890';
end;

procedure TForm1.StringGrid1PrepareCanvas(sender: TObject; aCol, aRow: Integer;
  aState: TGridDrawState);
  var
    ATextStyle: TTextStyle;
begin
ATextStyle := StringGrid1.Canvas.TextStyle;
ATextStyle.SingleLine := false;
ATextStyle.Wordbreak := true;
StringGrid1.Canvas.TextStyle := ATextStyle;
end;       

[Avogadro]

Bisogna settare l'altezza della riga nell' ispettore degli oggetti.

Non so se si puo' gestire dinamicamente a run time , io in una mia applicazione l' ho settata a design-time ad un dato valore che andava bene per il testo che mediamente dovevo gestire.

In altre applicazioni purtuttavia ho preferito usare un approcio diverso perché questo approcio rallentava l' applicazione a run time.

Se serve posso postare gli screen shot .

Ciao

[Avogadro]

Allora, in una mia applicazione ho fatto così:

procedure TForm1.DBGrid1PrepareCanvas(sender: TObject; DataCol: Integer;
  Column: TColumn; AState: TGridDrawState);
var
  MyTextStyle: TTextStyle;
begin
  case column.FieldName of                     // ) or (column.FieldName='IND') or (column.FieldName='REF') or  (column.FieldName='Comune')then
       'Descrizione','descr','des_loc','rif_scad','stato','taglio','mod_cons': begin
                    MyTextStyle := Dbgrid1.Canvas.TextStyle;
                    MyTextStyle.SingleLine := false;
                    MyTextStyle.Wordbreak:=true;
                    Dbgrid1.Canvas.TextStyle := MyTextStyle;
                    end;
      end; // case

  if sqlQuery1.FieldByName('data_scad').AsDateTime<=date  then
      with (Sender As TDBGrid) do
      begin
        //Custom drawing
        Canvas.Brush.Color:=clYellow;
        Canvas.Font.Color:=clRed;
        Canvas.Font.Style:=[fsBold];
      end;
  //if sqlQuery1.FieldByName('stato').Asstring='chiuso'  then
  case sqlQuery1.FieldByName('stato').Asstring of
       'chiuso': begin
                   with (Sender As TDBGrid) do
                        begin
                          Canvas.Font.Color:=clblue;
                          end;

                   end;
       'finito': begin
                   with (Sender As TDBGrid) do
                        begin
                          Canvas.Font.Color:=clpurple;
                          end;
                   end;
      end;

end;   

Nell' ispettore degli oggetti  ho fissato l'altezza della riga della dbgrid1 a 50 ( DefaultRowHeigt 50).

L'applicazione va, l' interfaccia è intuitiva ed apprezzata dall' utenza, ma  ovviamente a run time c'è un rallentamento, pertanto in altre applicazioni ho optato per un' alternativa: creo una form ad hoc con dei memo e delle labeledit e attraverso un menu popup associato alla grid attivo la form ed edito i dati:

procedure TForm1.MenuItem10Click(Sender: TObject);
begin
  if Zquery3.State<>dsbrowse then begin
     showmessage('Zquery3 not in dsbrowse mode');
     exit;
  end;
  if zquery3lock.AsBoolean=true then begin
     showmessage('Field locked');
     exit;
  end;
  if zquery3used.AsBoolean=false then
     if  QuestionDlg ('Attenzione','Il campo "used" è "deflegged", procedere comunque all'' edit ?',mtCustom,[mrYes,'Si', mrNo, 'No'],'')= mrNo then
         exit;

  form3.LabeledEdit1.Text:=zquery3matrice.AsString;
  form3.LabeledEdit2.Text:=zquery3tipolologia.AsString;
  form3.LabeledEdit3.Text:=zquery3metodica.AsString;
  form3.LabeledEdit4.Text:=zquery3FLA.AsString;
  form3.LabeledEdit5.Text:=zquery3RIF_TAR.AsString;
  form3.LabeledEdit6.Text:=zquery3costoF.AsString;
  form3.LabeledEdit10.Text:=zquery3costo1.text;
  form3.LabeledEdit7.Text:=zquery3NUM.AsString;
  form3.LabeledEdit11.Text:=zquery3np1.AsString;
  form3.LabeledEdit12.Text:=zquery3costopn1.text;
  form3.LabeledEdit13.Text:=zquery3smalt.AsString;
  form3.LabeledEdit14.Text:=zquery3costosmalt1.text;
  form3.LabeledEdit15.Text:=zquery3giud.AsString;
  form3.LabeledEdit16.Text:=zquery3costogiu1.Text;
  form3.LabeledEdit19.Text:=zquery3imponibile1.text;
  form3.LabeledEdit17.Text:=zquery3iva.AsString;
  form3.LabeledEdit18.Text:=zquery3costoiva1.text;
  form3.LabeledEdit20.Text:=zquery3totaleriga1.Text;;
  form3.Memo1.Text:=zquery3parametro.AsString;

  form3.showmodal;

  if form3.ModalResult<>mrOk then
     exit;
  application.ProcessMessages;
  form1.Cursor:=crSQLWait;

  zquery3.edit;
  zquery3matrice.AsString:=form3.LabeledEdit1.Text;
  zquery3tipolologia.AsString:=form3.LabeledEdit2.Text;
  zquery3metodica.AsString:=form3.LabeledEdit3.Text;
  zquery3FLA.AsString:=form3.LabeledEdit4.Text;
  zquery3RIF_TAR.AsString:=form3.LabeledEdit5.Text;
  zquery3costoF.AsString:=form3.LabeledEdit6.Text;
  //form3.LabeledEdit10.Text:=zquery3costo1.text;
  zquery3NUM.AsString:=form3.LabeledEdit7.Text;
  //form3.LabeledEdit11.Text:=zquery3np1.AsString;
  //form3.LabeledEdit12.Text:=zquery3costopn1.text;
  zquery3smalt.AsString:=form3.LabeledEdit13.Text;
  //form3.LabeledEdit14.Text:=zquery3costosmalt1.text;
  zquery3giud.AsString:=form3.LabeledEdit15.Text;
  //form3.LabeledEdit16.Text:=zquery3costogiu1.Text;
  //form3.LabeledEdit19.Text:=zquery3imponibile1.text;
  zquery3iva.AsString:=form3.LabeledEdit17.Text;
  //form3.LabeledEdit18.Text:=zquery3costoiva1.text;
  //form3.LabeledEdit20.Text:=zquery3totaleriga1.Text;;
  zquery3parametro.AsString:=form3.Memo1.Text;
  zquery3.post;

  zquery1.Edit;
  zquery1data_edit.AsString:=formatDateTime('YYYY/MM/DD',Date);
  zquery1.Post;

  form1.Cursor:=crDefault;

end;
       

Questa alternativa l'ho trovata piu' performante dell' approccio di mettere piu' righe in una casella della dbgrid ed anche l' utenza finale l'ha apprezzata (alla fine, come gli audit insegnao,  il cliente ha sempre ragione ) .


Ciao

[bonmario]

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

Codice: [Seleziona]

{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;

[Narciso]

Bonmario, la tua procedura è buona tranne per il fatto che se cambi i font e per esempio metti un font con altezza 24... e poi torni ad un font diciamo... 8 le celle non si ridimensionano

[bonmario]

A me non è mai servito cambiare font con il programma in esecuzione, ma credo che se la richiami dopo aver cambiato il font, dovrebbe funzionare.

Ciao, Mario

[bonmario]

Ho fatto una prova veloce.
Se modifichi questa riga:

Codice: [Seleziona]

if ((DrawRect.Bottom - DrawRect.Top) > RowHeights[aRow]) then begin

facendola diventare così:

Codice: [Seleziona]

if ((DrawRect.Bottom - DrawRect.Top) <> RowHeights[aRow]) then begin

Dovrebbe funzionare.

Ciao, Mario

[Narciso]

Grazie..

[Narciso]

ma non va lo stesso

[bonmario]

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:

Codice: [Seleziona]

  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

[Narciso]

hai ragione, il problema era che le mie stringhe eccedevano la larghezza della cella... in quel caso .. eh si deve ridimensionare anche la larghezza.

[bonmario]

Perfetto ... tutto è bene ciò che finisce bene !!!!

Ciao, Mario