GridPrinter: Add demo for usage of OnPrepareCanvas event.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8594 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2022-11-08 23:27:38 +00:00
parent 5733bf1c3b
commit c31b6d5e6e
5 changed files with 314 additions and 1 deletions

View File

@ -0,0 +1,86 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="12"/>
<PathDelim Value="\"/>
<General>
<Flags>
<CompatibilityMode Value="True"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<Title Value="formatted_stringgrid_demo"/>
<Scaled Value="True"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<XPManifest>
<DpiAware Value="True"/>
</XPManifest>
</General>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<UseFileFilters Value="True"/>
</PublishOptions>
<RunParams>
<FormatVersion Value="2"/>
</RunParams>
<RequiredPackages Count="2">
<Item1>
<PackageName Value="GridPrinterPkg"/>
</Item1>
<Item2>
<PackageName Value="LCL"/>
</Item2>
</RequiredPackages>
<Units Count="2">
<Unit0>
<Filename Value="formatted_stringgrid_demo.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="Formatted_StringGrid_Demo"/>
</Unit0>
<Unit1>
<Filename Value="main.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="MainForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
</Unit1>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="formatted_stringgrid_demo"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<Debugging>
<DebugInfoType Value="dsDwarf3"/>
</Debugging>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

View File

@ -0,0 +1,25 @@
program Formatted_StringGrid_Demo;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}
cthreads,
{$ENDIF}
{$IFDEF HASAMIGA}
athreads,
{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, main
{ you can add units after this };
{$R *.res}
begin
RequireDerivedFormResource:=True;
Application.Scaled:=True;
Application.Initialize;
Application.CreateForm(TMainForm, MainForm);
Application.Run;
end.

View File

@ -0,0 +1,76 @@
object MainForm: TMainForm
Left = 356
Height = 441
Top = 194
Width = 779
Caption = 'MainForm'
ClientHeight = 441
ClientWidth = 779
OnCreate = FormCreate
LCLVersion = '2.3.0.0'
object ButtonPanel: TPanel
Left = 0
Height = 37
Top = 404
Width = 779
Align = alBottom
AutoSize = True
BevelOuter = bvNone
ClientHeight = 37
ClientWidth = 779
TabOrder = 0
object btnPrint: TButton
AnchorSideLeft.Control = ButtonPanel
AnchorSideTop.Control = ButtonPanel
Left = 6
Height = 25
Top = 6
Width = 60
AutoSize = True
BorderSpacing.Around = 6
Caption = 'Print...'
OnClick = btnPrintClick
TabOrder = 0
end
object btnPreview: TButton
AnchorSideLeft.Control = btnPrint
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = ButtonPanel
Left = 78
Height = 25
Top = 6
Width = 76
AutoSize = True
BorderSpacing.Left = 6
BorderSpacing.Around = 6
Caption = 'Preview...'
OnClick = btnPreviewClick
TabOrder = 1
end
end
object StringGrid1: TStringGrid
Left = 6
Height = 398
Top = 6
Width = 767
Align = alClient
BorderSpacing.Left = 6
BorderSpacing.Top = 6
BorderSpacing.Right = 6
Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goDrawFocusSelected, goRowSizing, goColSizing, goThumbTracking, goSmoothScroll]
TabOrder = 1
end
object GridPrinter1: TGridPrinter
Grid = StringGrid1
Footer.Font.Height = -11
Header.Font.Height = -11
ShowPrintDialog = gpdPrintDialog
Left = 218
Top = 147
end
object GridPrintPreviewDialog1: TGridPrintPreviewDialog
GridPrinter = GridPrinter1
Left = 400
Top = 147
end
end

View File

@ -0,0 +1,126 @@
unit main;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, Grids,
StdCtrls, GridPrn, GridPrnPreviewDlg;
type
{ TMainForm }
TMainForm = class(TForm)
btnPrint: TButton;
btnPreview: TButton;
ButtonPanel: TPanel;
GridPrinter1: TGridPrinter;
GridPrintPreviewDialog1: TGridPrintPreviewDialog;
StringGrid1: TStringGrid;
procedure btnPreviewClick(Sender: TObject);
procedure btnPrintClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure PrepareCanvasHandler(Sender: TObject; aCol, aRow: Integer;
aState: TGridDrawState);
private
public
end;
var
MainForm: TMainForm;
implementation
{$R *.lfm}
{ TMainForm }
procedure TMainForm.btnPrintClick(Sender: TObject);
begin
GridPrinter1.Print;
end;
procedure TMainForm.btnPreviewClick(Sender: TObject);
begin
GridPrintPreviewDialog1.Execute;
end;
procedure TMainForm.FormCreate(Sender: TObject);
const
NUM_ROWS = 100;
NUM_COLS = 20;
var
r, c: Integer;
begin
StringGrid1.BeginUpdate;
try
StringGrid1.Clear;
StringGrid1.RowCount := NUM_ROWS + StringGrid1.FixedRows;
StringGrid1.ColCount := NUM_COLS + StringGrid1.FixedCols;
for r := StringGrid1.FixedRows to StringGrid1.RowCount-1 do
StringGrid1.Cells[0, r] := 'Row ' + IntToStr(r);
for c := StringGrid1.FixedCols to StringGrid1.ColCount-1 do
begin
StringGrid1.Cells[c, 0] := 'Column ' + IntToStr(c);
for r := StringGrid1.FixedRows to StringGrid1.RowCount-1 do
StringGrid1.Cells[c, r] := Format('C%d R%d', [c, r]);
end;
StringGrid1.Cells[6, 5] := 'This is a long text';
StringGrid1.DefaultColWidth := 80;
StringGrid1.ColWidths[3] := 40;
StringGrid1.RowHeights[5] := 60;
StringGrid1.Options := StringGrid1.Options + [goCellEllipsis];
StringGrid1.AlternateColor := clMoneyGreen;
StringGrid1.OnPrepareCanvas := @PrepareCanvasHandler;
GridPrinter1.OnPrepareCanvas := @PrepareCanvasHandler;
finally
StringGrid1.EndUpdate;
end;
end;
procedure TMainForm.PrepareCanvasHandler(Sender: TObject; aCol,
aRow: Integer; aState: TGridDrawState);
var
lCanvas: TCanvas;
ts: TTextStyle;
begin
if Sender = StringGrid1 then
lCanvas := StringGrid1.Canvas
else
if Sender = GridPrinter1 then
lCanvas := GridPrinter1.Canvas
else
raise Exception.Create('Unknown sender of OnPrepareCanvas.');
ts := lCanvas.TextStyle;
if (ACol = 3) and (ARow >= StringGrid1.FixedRows) and odd(ARow) then
begin
lCanvas.Brush.Color := clSkyBlue;
lCanvas.Font.Color := clBlue;
end;
if (ACol = 6) and (ARow = 5) then
begin
ts.Wordbreak := true;
ts.SingleLine := false;
lCanvas.Font.Size := 12;
lCanvas.Font.Style := [fsBold];
end;
if (ARow = 5) then
begin
ts.Alignment := taRightJustify;
end;
lCanvas.TextStyle := ts;
end;
end.

View File

@ -863,7 +863,7 @@ begin
begin
color := ColorToRGB(lGrid.Color);
alternateColor := ColorToRGB(lGrid.AlternateColor);
if (color <> alternateColor) and Odd(ARow) then
if (color <> alternateColor) and not Odd(ARow) then
ACanvas.Brush.Color := alternateColor
else
ACanvas.Brush.Color := color;