Cambiare font del carattere su StringGrid in dinamico (risolto)

[Nicola]

Buon giorno;
mi spiego ho una stringgrid con valori numerici, alla fine all'ultima riga inserisco i totali delle colonne; vorrei
che appunto tali totali fossero di un font diverso e in grassetto; come posso fare visto che il numero delle righe
puo essere variabile?
grazie

[xinyiman]

Ciao Nicola, allora devi cambiare il tipo di font a RunTime, quando nella StringGrid vai ad inserire l'ultima riga , li devi cambiare il font a RunTime. Se non ci riesci, fai un programma di prova con una stringgrid e poi lo pubblichi qui. Io o altri lo modifichiamo per farti capire come si fa

[Nicola]

Purtroppo non saprei come fare, date le mie limitate conoscenze, quindi posto il codice e una videata di esempio;
il codice è semplificato ma il concetto è quello:

Codice: [Seleziona]

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Grids,
  StdCtrls;

type

  Numeri=record
    Primo:integer;
    Secondo:integer;
    Terzo:integer;
  end;

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Label1: TLabel;
    StringGrid1: TStringGrid;
    procedure Button1Click(Sender: TObject);
    procedure Edit1EditingDone(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;
  NumeroRighe:integer;
  ArrayRighe:array[1..100] of Numeri;
  TotPrimo,TotSecondo,TotTerzo:Integer;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.Edit1EditingDone(Sender: TObject);
begin
if Edit1.Text<>'' then begin
                       NumeroRighe:=StrToInt(Edit1.Text);
                       if NumeroRighe<1 then NumeroRighe:=1;
                       end
                  else NumeroRighe:=1;
end;

procedure TForm1.Button1Click(Sender: TObject);
Var Cl,Rw,I:integer;
begin
StringGrid1.Clean([gznormal]);
StringGrid1.RowCount:=NumeroRighe+3;
For Rw:=1 to NumeroRighe
    do with StringGrid1
       do begin
       Cl:=0;
       Cells[Cl,Rw]:=IntToStr(ArrayRighe[Rw].Primo);inc(Cl);
       Cells[Cl,Rw]:=IntToStr(ArrayRighe[Rw].Secondo);inc(Cl);
       Cells[Cl,Rw]:=IntToStr(ArrayRighe[Rw].Terzo);
       end;
TotPrimo:=0;TotSecondo:=0;TotTerzo:=0;
for I:=1 to NumeroRighe
    do begin
    TotPrimo:=TotPrimo+ArrayRighe[I].Primo;
    TotSecondo:=TotSecondo+ArrayRighe[I].Secondo;
    TotTerzo:=TotTerzo+ArrayRighe[I].Terzo;
    end;
// da qua vorrei che il testo fosse di altro colore, font, e grassetto
With StringGrid1
   do begin
   inc(rw);
   Cells[0,rw]:='--';
   Cells[1,rw]:='--';
   Cells[2,rw]:='--';
   inc(rw);
   Cells[0,rw]:=IntToStr(TotPrimo);
   Cells[1,rw]:=IntToStr(TotSecondo);
   Cells[2,rw]:=IntToStr(TotTerzo);
   end;
end;

procedure TForm1.FormShow(Sender: TObject);
var I:integer;
begin
for  I:=1 to 100 do begin
                 ArrayRighe[I].Primo:=I*5;
                 ArrayRighe[I].Secondo:=I*6;
                 ArrayRighe[I].Terzo:=I*7;
                 end;
Edit1.SetFocus;
end;

end.

[xinyiman]

Guarda questo esempio

[Nicola]

Proprio cio' che mi serviva grazie; ora giusto per capire e non fare un mero copia incolla:
quando creo il form riga_diversa assume il valore di -1; se la variabile ha tale valore la griglia
viene creata con i parametri di default; se riga_diversa non è piu' -1 allora tramite  StringGrid1DrawCell
cambio i parametri di scrittura cella; corretto?

[xinyiman]

Esatto, il concetto è quello. OnDrawCell è l'evento chiamato nel momento in cui viene disegnato il contenuto della singola cella (di tutte, anche quelle vuote)

[Nicola]

Niente da fare. Ho modificato il tuo esempio e mi funziona tutto; quando poi lo trasporto nel
mio programma mi scrive ancora in nero, non capisco dove sbaglio.

Codice: [Seleziona]

procedure TTfVisualizzazioneManutenzioneCespitiQuote.SgMostraCespitiDrawCell(Sender: TObject; aCol, aRow: Integer; aRect: TRect; aState: TGridDrawState);
 var

  RectForText: TRect;

  begin
   if ((riga_diversa<>-1) and (aRow>=riga_diversa))
       then with SgMostraCespiti.Canvas
                 do begin
                     Font.Color := clRed;
                     Font.Style := [fsBold];
                     TextRect(aRect, aRect.Left + 2, aRect.Top + 2,
                                SgMostraCespiti.Cells[aCol, aRow]);
                    end;
  end;



Procedure TTfVisualizzazioneManutenzioneCespitiQuote.PopolaGrigliaCespiti;
 var
   Cl,Rg,ii,IdxYear:integer;

 begin
  AzzeraGriglia;
  PCespitiSelezionatiDes.Caption:=IntToStr(IdxCespToShow);
  SgMostraCespiti.RowCount:=IdxCespToShow+1;
  for Rg:=1 to IdxCespToShow
      do with SgMostraCespiti
         do begin
             Cl:=0;
             if ArrCespitiToShow[Rg].Venduto then Riga_Diversa:=Rg
                                             else Riga_Diversa:=-1;
             Cells[Cl,Rg]:= IntToStr(ArrCespitiToShow[Rg].NumeroCespite);inc(Cl);  

[Stilgar]

Le impostazioni delle griglia a designer sono le stesse che ti ha passato xiny?
Forse la differenza sta nel file lfm e non nel pas?
Stilgar

[Avogadro]

Perdonate se ne approfitto.

Qui

http://artsoft.tech/download.html#rep

c'è del codice, ArtRepor, per poter fare dei report in excel , con tutti vantaggi che questo comporta ( formattazione condizionale tec)

Ho scaricato artreport per lazarus ma non riesco a installarlo, forse perchè fa riferimento alla versione di lazarus in
auge nel 2010.

C' è un modo per farlo funzionare con la versione attuale di lazarus ?

[Stilgar]

Ciao
Rompe per l'assenza di ExpandFileNameUTF8?
Stilgar

[Nicola]

Be no ho personalizzato la mia griglia, quella di xinyiman era un asemplice griglia

Codice: [Seleziona]

 object SgMostraCespiti: TStringGrid
      Left = 5
      Height = 576
      Top = 8
      Width = 1235
      ColCount = 15
      ColumnClickSorts = True
      Columns = <      
        item
          Alignment = taCenter
          Font.CharSet = ARABIC_CHARSET
          Font.Height = -11
          Font.Name = 'KacstOffice'
          Font.Pitch = fpVariable
          Font.Quality = fqDraft
          Title.Alignment = taCenter
          Title.Font.CharSet = ARABIC_CHARSET
          Title.Font.Height = -11
          Title.Font.Name = 'KacstOffice'
          Title.Font.Pitch = fpVariable
          Title.Font.Quality = fqDraft
          Title.Caption = 'N.'
          Width = 40
        end      
        item
          Alignment = taCenter
          Font.CharSet = ARABIC_CHARSET
          Font.Height = -11
          Font.Name = 'KacstOffice'
          Font.Pitch = fpVariable
          Font.Quality = fqDraft
          Title.Alignment = taCenter
          Title.Font.CharSet = ARABIC_CHARSET
          Title.Font.Height = -11
          Title.Font.Name = 'KacstOffice'
          Title.Font.Pitch = fpVariable
          Title.Font.Quality = fqDraft
          Title.Caption = 'Pr.'
          Width = 40
        end      
        item
          Alignment = taCenter
          Font.CharSet = ARABIC_CHARSET
          Font.Height = -11
          Font.Name = 'KacstOffice'
          Font.Pitch = fpVariable
          Font.Quality = fqDraft
          Title.Alignment = taCenter
          Title.Font.CharSet = ARABIC_CHARSET
          Title.Font.Height = -11
          Title.Font.Name = 'KacstOffice'
          Title.Font.Pitch = fpVariable
          Title.Font.Quality = fqDraft
          Title.Caption = 'Data Doc.'
          Width = 75
        end      
        item
          Alignment = taCenter
          Font.CharSet = ARABIC_CHARSET
          Font.Height = -11
          Font.Name = 'KacstOffice'
          Font.Pitch = fpVariable
          Font.Quality = fqDraft
          Title.Alignment = taCenter
          Title.Font.CharSet = ARABIC_CHARSET
          Title.Font.Height = -11
          Title.Font.Name = 'KacstOffice'
          Title.Font.Pitch = fpVariable
          Title.Font.Quality = fqDraft
          Title.Caption = 'Data Reg.'
          Width = 75
        end      
        item
          Font.CharSet = ARABIC_CHARSET
          Font.Height = -11
          Font.Name = 'KacstOffice'
          Font.Pitch = fpVariable
          Font.Quality = fqDraft
          Title.Font.CharSet = ARABIC_CHARSET
          Title.Font.Height = -11
          Title.Font.Name = 'KacstOffice'
          Title.Font.Pitch = fpVariable
          Title.Font.Quality = fqDraft
          Title.Caption = 'N.Doc.'
          Width = 75
        end      
        item
          Alignment = taCenter
          Font.CharSet = ARABIC_CHARSET
          Font.Height = -11
          Font.Name = 'KacstOffice'
          Font.Pitch = fpVariable
          Font.Quality = fqDraft
          Title.Alignment = taCenter
          Title.Font.CharSet = ARABIC_CHARSET
          Title.Font.Height = -11
          Title.Font.Name = 'KacstOffice'
          Title.Font.Pitch = fpVariable
          Title.Font.Quality = fqDraft
          Title.Caption = 'Prot.'
          Width = 40
        end      
        item
          Font.CharSet = ARABIC_CHARSET
          Font.Height = -11
          Font.Name = 'KacstOffice'
          Font.Pitch = fpVariable
          Font.Quality = fqDraft
          Title.Font.CharSet = ARABIC_CHARSET
          Title.Font.Height = -11
          Title.Font.Name = 'KacstOffice'
          Title.Font.Pitch = fpVariable
          Title.Font.Quality = fqDraft
          Title.Caption = 'Fornitore'
          Width = 120
        end      
        item
          Font.CharSet = ARABIC_CHARSET
          Font.Height = -11
          Font.Name = 'KacstOffice'
          Font.Pitch = fpVariable
          Font.Quality = fqDraft
          Title.Font.CharSet = ARABIC_CHARSET
          Title.Font.Height = -11
          Title.Font.Name = 'KacstOffice'
          Title.Font.Pitch = fpVariable
          Title.Font.Quality = fqDraft
          Title.Caption = 'Desc.Cespite'
          Width = 300
        end      
        item
          Font.CharSet = ARABIC_CHARSET
          Font.Height = -11
          Font.Name = 'KacstOffice'
          Font.Pitch = fpVariable
          Font.Quality = fqDraft
          Title.Font.CharSet = ARABIC_CHARSET
          Title.Font.Height = -11
          Title.Font.Name = 'KacstOffice'
          Title.Font.Pitch = fpVariable
          Title.Font.Quality = fqDraft
          Title.Caption = 'Categ.'
          Width = 55
        end      
        item
          Alignment = taRightJustify
          Font.CharSet = ARABIC_CHARSET
          Font.Height = -11
          Font.Name = 'KacstOffice'
          Font.Pitch = fpVariable
          Font.Quality = fqDraft
          Title.Alignment = taRightJustify
          Title.Font.CharSet = ARABIC_CHARSET
          Title.Font.Height = -11
          Title.Font.Name = 'KacstOffice'
          Title.Font.Pitch = fpVariable
          Title.Font.Quality = fqDraft
          Title.Caption = 'Costo 01/01'
          Width = 70
        end      
        item
          Alignment = taRightJustify
          Font.CharSet = ARABIC_CHARSET
          Font.Height = -11
          Font.Name = 'KacstOffice'
          Font.Pitch = fpVariable
          Font.Quality = fqDraft
          Title.Alignment = taRightJustify
          Title.Font.CharSet = ARABIC_CHARSET
          Title.Font.Height = -11
          Title.Font.Name = 'KacstOffice'
          Title.Font.Pitch = fpVariable
          Title.Font.Quality = fqDraft
          Title.Caption = 'Aliq.%'
          Width = 50
        end      
        item
          Alignment = taRightJustify
          Font.CharSet = ARABIC_CHARSET
          Font.Height = -11
          Font.Name = 'KacstOffice'
          Font.Pitch = fpVariable
          Font.Quality = fqDraft
          Title.Alignment = taRightJustify
          Title.Font.CharSet = ARABIC_CHARSET
          Title.Font.Height = -11
          Title.Font.Name = 'KacstOffice'
          Title.Font.Pitch = fpVariable
          Title.Font.Quality = fqDraft
          Title.Caption = '% Det.'
          Width = 50
        end      
        item
          Alignment = taRightJustify
          Font.CharSet = ARABIC_CHARSET
          Font.Height = -11
          Font.Name = 'KacstOffice'
          Font.Pitch = fpVariable
          Font.Quality = fqDraft
          Title.Alignment = taRightJustify
          Title.Font.CharSet = ARABIC_CHARSET
          Title.Font.Height = -11
          Title.Font.Name = 'KacstOffice'
          Title.Font.Pitch = fpVariable
          Title.Font.Quality = fqDraft
          Title.Caption = 'F.do 01/01'
          Width = 70
        end      
        item
          Alignment = taRightJustify
          Font.CharSet = ARABIC_CHARSET
          Font.Height = -11
          Font.Name = 'KacstOffice'
          Font.Pitch = fpVariable
          Font.Quality = fqDraft
          Title.Alignment = taRightJustify
          Title.Font.CharSet = ARABIC_CHARSET
          Title.Font.Height = -11
          Title.Font.Name = 'KacstOffice'
          Title.Font.Pitch = fpVariable
          Title.Font.Quality = fqDraft
          Title.Caption = 'Res. 01/01'
          Width = 70
        end      
        item
          Alignment = taRightJustify
          Font.CharSet = ARABIC_CHARSET
          Font.Height = -11
          Font.Name = 'KacstOffice'
          Font.Pitch = fpVariable
          Font.Quality = fqDraft
          Title.Alignment = taRightJustify
          Title.Font.CharSet = ARABIC_CHARSET
          Title.Font.Height = -11
          Title.Font.Name = 'KacstOffice'
          Title.Font.Pitch = fpVariable
          Title.Font.Quality = fqDraft
          Title.Caption = 'Cod.'
          Width = 80
        end>
      DefaultRowHeight = 19
      FixedCols = 0
      Font.CharSet = ANSI_CHARSET
      Font.Height = -11
      Font.Name = 'Calibri Light'
      Font.Pitch = fpVariable
      Font.Quality = fqDraft
      Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goSmoothScroll, goRowHighlight]
      ParentFont = False
      TabOrder = 0
      TitleFont.CharSet = ANSI_CHARSET
      TitleFont.Height = -12
      TitleFont.Name = 'Open Sans'
      TitleFont.Pitch = fpVariable
      TitleFont.Quality = fqDraft
      OnDblClick = SgMostraCespitiDblClick
      OnDrawCell = SgMostraCespitiDrawCell
      ColWidths = (
        40
        40
        75
        75
        75
        40
        120
        300
        55
        70
        50
        50
        70
        70
        80
      )
      Cells = (
        1
        2
        0
        'N.Cesp.'
      )
    end                      

[Stilgar]

Prova a disabilitare il flag "DefaultDraw'.
Ora controllo, mi sembrava inibisse l'uso della callback per il disegno personalizzarto delle celle.
Stilgar

[Stilgar]

Na... ricordavo male.
Però puoi usare OnPrepareCanvas.Credo sia pensato proprio per quello che devi fare tu.
Viene chiamato prima di disegnare il contenuto.
Così non mescoli la logica di disegno del contenuto con la preparazione del canvas per il disegno.
Stilgar
(Vedo di modificare l'esempio di xiny per farti vedere come lavorare in questa direzione).

[Stilgar]

Ecco qui
 Giocando con i font e l'allineamento dei caratteri, forse è più chiaro come usare le due callback (E si, bisognava disabilitare il default draw se si vuole che il font e il resto venga cambiato a dovere )
Stilgar

Codice: [Seleziona]

procedure TForm1.StringGrid1DrawCell(Sender: TObject; aCol, aRow: integer; aRect: TRect; aState: TGridDrawState);
var
  ts: TTextStyle;
  testoDaDisegnare: string;
begin
  with TStringGrid(Sender) do
  begin
    if DefaultDrawing then
      exit;
    canvas.Rectangle(aRect);
    Dec(ARect.Right, varCellPadding);
    case Canvas.TextStyle.Alignment of
      Classes.taLeftJustify: Inc(ARect.Left, varCellPadding);
      Classes.taRightJustify: Dec(ARect.Right, 1);
    end;
    case Canvas.TextStyle.Layout of
      tlTop: Inc(ARect.Top, varCellPadding);
      tlBottom: Dec(ARect.Bottom, varCellPadding);
    end;

    if ARect.Right < ARect.Left then
      ARect.Right := ARect.Left;
    if ARect.Left > ARect.Right then
      ARect.Left := ARect.Right;
    if ARect.Bottom < ARect.Top then
      ARect.Bottom := ARect.Top;
    if ARect.Top > ARect.Bottom then
      ARect.Top    := ARect.Bottom;
    ts.Opaque      := True;
    ts.Alignment   := taRightJustify;
    ts.Layout      := tlCenter;
    if aRow = 0 then
      ts.Alignment := taCenter;
    if (ARect.Left <> ARect.Right) and (ARect.Top <> ARect.Bottom) then
    begin
      if aRow = 0 then
      begin
        testoDaDisegnare := Columns[aCol].Title.Caption;
      end
      else
        testoDaDisegnare := Cells[aCol, aRow];
      Canvas.TextRect(aRect, ARect.Left, ARect.Top, testoDaDisegnare, ts);
    end;
  end;
end;

procedure TForm1.StringGrid1PrepareCanvas(Sender: TObject; aCol, aRow: integer; aState: TGridDrawState);
begin
  PrepareCanvas(Sender as TStringGrid, aRow);
end;

procedure TForm1.PrepareCanvas(StringGrid: TStringGrid; aRow: integer);
const
  backgrounds          : array[boolean] of TColor = (clMoneyGreen, clSkyBlue);
begin
  with StringGrid.Canvas do
  begin
    if aRow > 0 then
      Brush.Color := backgrounds[odd(aRow)];
    if aRow = 0 then
    begin
      Font.Color   := clWhite;
      Brush.Color  := clAppWorkspace;
      Font.Style   := [fsUnderline];
      Font.Size    := 10;
      Font.Name    := 'Arial';
    end
    else
    begin
      Font.Color   := clRed;
      Font.Style   := [fsItalic];
      Font.Size    := 10;
      Font.Size    := 9;
      Font.Name    := 'Consolas';
      if ((riga_diversa <> -1) and (aRow > riga_diversa)) then
      begin
        Font.Color := clBlue;
        Font.Style := [fsBold];
      end;
      if ((riga_diversa <> -1) and (aRow = riga_diversa)) then
      begin
        Font.Color := clBlue;
        Font.Style := [fsStrikeOut];
      end;
    end;
    Pen.Style := psClear;
  end;
end;
        

[Avogadro]

Ciao
Rompe per l'assenza di ExpandFileNameUTF8?
Stilgar

No

https://lazarus-ccr.sourceforge.io/docs/lazutils/lazfileutils/expandfilenameutf8.html


E' che non riesco ad installare i pacchetti e quindi poi il demoL non va .