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:
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.
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.
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);
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
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
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;