You've already forked lazarus-ccr
fpspreadsheet: Add variant of the fpsgrid demo which does not require installation of the laz_fpspreadsheet_visual package. Fix incorrect centering of text in merged cells.
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3565 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
@ -55,15 +55,15 @@ object Form1: TForm1
|
||||
FrozenRows = 0
|
||||
ReadFormulas = False
|
||||
Align = alClient
|
||||
AutoAdvance = aaDown
|
||||
ColCount = 27
|
||||
ExtendedSelect = False
|
||||
MouseWheelOption = mwGrid
|
||||
Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goRowSizing, goColSizing, goEditing, goThumbTracking, goSmoothScroll, goFixedColSizing]
|
||||
RowCount = 101
|
||||
TabOrder = 1
|
||||
TitleStyle = tsNative
|
||||
ColWidths = (
|
||||
56
|
||||
42
|
||||
64
|
||||
64
|
||||
64
|
||||
@ -104,19 +104,19 @@ object Form1: TForm1
|
||||
TabOrder = 2
|
||||
object Label1: TLabel
|
||||
Left = 8
|
||||
Height = 20
|
||||
Height = 15
|
||||
Top = 9
|
||||
Width = 46
|
||||
Width = 37
|
||||
Caption = 'Sheets:'
|
||||
ParentColor = False
|
||||
end
|
||||
object SheetsCombo: TComboBox
|
||||
Left = 72
|
||||
Height = 28
|
||||
Height = 23
|
||||
Top = 4
|
||||
Width = 808
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
ItemHeight = 20
|
||||
ItemHeight = 15
|
||||
ItemIndex = 0
|
||||
Items.Strings = (
|
||||
'Sheet 1'
|
||||
|
BIN
components/fpspreadsheet/examples/fpsgrid_no_install/fpsgrid.ico
Normal file
BIN
components/fpspreadsheet/examples/fpsgrid_no_install/fpsgrid.ico
Normal file
Binary file not shown.
After Width: | Height: | Size: 134 KiB |
115
components/fpspreadsheet/examples/fpsgrid_no_install/fpsgrid.lpi
Normal file
115
components/fpspreadsheet/examples/fpsgrid_no_install/fpsgrid.lpi
Normal file
@ -0,0 +1,115 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="9"/>
|
||||
<PathDelim Value="\"/>
|
||||
<General>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<MainUnit Value="0"/>
|
||||
<Title Value="fpsgrid"/>
|
||||
<ResourceType Value="res"/>
|
||||
<UseXPManifest Value="True"/>
|
||||
<Icon Value="0"/>
|
||||
</General>
|
||||
<i18n>
|
||||
<EnableI18N LFM="False"/>
|
||||
</i18n>
|
||||
<VersionInfo>
|
||||
<StringTable ProductVersion=""/>
|
||||
</VersionInfo>
|
||||
<BuildModes Count="2">
|
||||
<Item1 Name="Debug" Default="True"/>
|
||||
<Item2 Name="Release">
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<PathDelim Value="\"/>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||
</SearchPaths>
|
||||
<CodeGeneration>
|
||||
<SmartLinkUnit Value="True"/>
|
||||
</CodeGeneration>
|
||||
<Linking>
|
||||
<Debugging>
|
||||
<StripSymbols Value="True"/>
|
||||
</Debugging>
|
||||
<LinkSmart Value="True"/>
|
||||
<Options>
|
||||
<Win32>
|
||||
<GraphicApplication Value="True"/>
|
||||
</Win32>
|
||||
</Options>
|
||||
</Linking>
|
||||
</CompilerOptions>
|
||||
</Item2>
|
||||
</BuildModes>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<local>
|
||||
<FormatVersion Value="1"/>
|
||||
</local>
|
||||
</RunParams>
|
||||
<RequiredPackages Count="2">
|
||||
<Item1>
|
||||
<PackageName Value="LazUtils"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<PackageName Value="LCL"/>
|
||||
</Item2>
|
||||
</RequiredPackages>
|
||||
<Units Count="2">
|
||||
<Unit0>
|
||||
<Filename Value="fpsgrid.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit0>
|
||||
<Unit1>
|
||||
<Filename Value="mainfrm.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="Form1"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<UnitName Value="mainfrm"/>
|
||||
</Unit1>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<PathDelim Value="\"/>
|
||||
<Target>
|
||||
<Filename Value="fpsgrid"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||
<OtherUnitFiles Value="..\.."/>
|
||||
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<CodeGeneration>
|
||||
<SmartLinkUnit Value="True"/>
|
||||
</CodeGeneration>
|
||||
<Linking>
|
||||
<Debugging>
|
||||
<DebugInfoType Value="dsDwarf2Set"/>
|
||||
</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>
|
@ -0,0 +1,21 @@
|
||||
program fpsgrid;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
uses
|
||||
{$IFDEF UNIX}{$IFDEF UseCThreads}
|
||||
cthreads,
|
||||
{$ENDIF}{$ENDIF}
|
||||
Interfaces, // this includes the LCL widgetset
|
||||
Forms, mainfrm
|
||||
{ you can add units after this };
|
||||
|
||||
{$R *.res}
|
||||
|
||||
begin
|
||||
RequireDerivedFormResource := True;
|
||||
Application.Initialize;
|
||||
Application.CreateForm(TForm1, Form1);
|
||||
Application.Run;
|
||||
end.
|
||||
|
@ -0,0 +1,72 @@
|
||||
object Form1: TForm1
|
||||
Left = 340
|
||||
Height = 413
|
||||
Top = 154
|
||||
Width = 676
|
||||
Caption = 'Form1'
|
||||
ClientHeight = 413
|
||||
ClientWidth = 676
|
||||
OnCreate = FormCreate
|
||||
LCLVersion = '1.3'
|
||||
object ButtonPanel: TPanel
|
||||
Left = 0
|
||||
Height = 38
|
||||
Top = 375
|
||||
Width = 676
|
||||
Align = alBottom
|
||||
BevelOuter = bvNone
|
||||
ClientHeight = 38
|
||||
ClientWidth = 676
|
||||
TabOrder = 0
|
||||
object BtnNew: TButton
|
||||
Left = 8
|
||||
Height = 25
|
||||
Top = 6
|
||||
Width = 75
|
||||
Caption = 'New'
|
||||
OnClick = BtnNewClick
|
||||
TabOrder = 0
|
||||
end
|
||||
object BtnLoad: TButton
|
||||
Left = 94
|
||||
Height = 25
|
||||
Top = 6
|
||||
Width = 75
|
||||
Caption = 'Load'
|
||||
OnClick = BtnLoadClick
|
||||
TabOrder = 1
|
||||
end
|
||||
object BtnSave: TButton
|
||||
Left = 180
|
||||
Height = 25
|
||||
Top = 6
|
||||
Width = 75
|
||||
Caption = 'Save'
|
||||
OnClick = BtnSaveClick
|
||||
TabOrder = 2
|
||||
end
|
||||
end
|
||||
object TabControl: TTabControl
|
||||
Left = 0
|
||||
Height = 375
|
||||
Top = 0
|
||||
Width = 676
|
||||
OnChange = TabControlChange
|
||||
Align = alClient
|
||||
TabOrder = 1
|
||||
end
|
||||
object OpenDialog: TOpenDialog
|
||||
DefaultExt = '.xls'
|
||||
Filter = 'Excel spreadsheet (*.xls)|*.xls|Excel XML spreadsheet (*.xlsx)|*.xlsx|LibreOffice/OpenOffice spreadsheet (*.ods)|*.ods|Wikitable (pipes) (.wikitable_pipes)|.wikitable_pipes|All files (*.*)|*.*'
|
||||
Options = [ofExtensionDifferent, ofEnableSizing, ofViewDetail]
|
||||
left = 192
|
||||
top = 96
|
||||
end
|
||||
object SaveDialog: TSaveDialog
|
||||
DefaultExt = '.xls'
|
||||
Filter = 'Excel spreadsheet (*.xls)|*.xls|Excel XML spreadsheet (*.xlsx)|*.xlsx|LibreOffice/OpenOffice spreadsheet (*.ods)|*.ods|Wikitable (wikimedia) (.wikitable_wikimedia)|*.wikitable_wikimedia'
|
||||
Options = [ofOverwritePrompt, ofExtensionDifferent, ofEnableSizing, ofViewDetail]
|
||||
left = 192
|
||||
top = 184
|
||||
end
|
||||
end
|
161
components/fpspreadsheet/examples/fpsgrid_no_install/mainfrm.pas
Normal file
161
components/fpspreadsheet/examples/fpsgrid_no_install/mainfrm.pas
Normal file
@ -0,0 +1,161 @@
|
||||
unit mainfrm;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
|
||||
ComCtrls, StdCtrls, Grids,
|
||||
fpSpreadsheet, fpspreadsheetgrid, fpsallformats;
|
||||
|
||||
type
|
||||
|
||||
{ TForm1 }
|
||||
|
||||
TForm1 = class(TForm)
|
||||
BtnNew: TButton;
|
||||
BtnLoad: TButton;
|
||||
BtnSave: TButton;
|
||||
ButtonPanel: TPanel;
|
||||
OpenDialog: TOpenDialog;
|
||||
SaveDialog: TSaveDialog;
|
||||
TabControl: TTabControl;
|
||||
procedure BtnLoadClick(Sender: TObject);
|
||||
procedure BtnNewClick(Sender: TObject);
|
||||
procedure BtnSaveClick(Sender: TObject);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure TabControlChange(Sender: TObject);
|
||||
private
|
||||
{ private declarations }
|
||||
Grid: TsWorksheetGrid;
|
||||
procedure LoadFile(const AFileName: String);
|
||||
public
|
||||
{ public declarations }
|
||||
end;
|
||||
|
||||
var
|
||||
Form1: TForm1;
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.lfm}
|
||||
|
||||
{ TForm1 }
|
||||
|
||||
procedure TForm1.FormCreate(Sender: TObject);
|
||||
begin
|
||||
Grid := TsWorksheetGrid.Create(self);
|
||||
|
||||
// Put the grid into the TabControl
|
||||
Grid.Parent := TabControl;
|
||||
Grid.Align := alClient;
|
||||
|
||||
// Useful options
|
||||
Grid.Options := Grid.Options + [goColSizing, goRowSizing, goEditing, goThumbTracking];
|
||||
Grid.AutoAdvance := aaDown;
|
||||
Grid.MouseWheelOption := mwGrid;
|
||||
Grid.TextOverflow := true;
|
||||
|
||||
// Create an empty worksheet
|
||||
Grid.NewWorkbook(26, 100);
|
||||
end;
|
||||
|
||||
procedure TForm1.BtnLoadClick(Sender: TObject);
|
||||
begin
|
||||
if OpenDialog.FileName <> '' then begin
|
||||
OpenDialog.InitialDir := ExtractFileDir(OpenDialog.FileName);
|
||||
OpenDialog.FileName := ChangeFileExt(ExtractFileName(OpenDialog.FileName), '');
|
||||
end;
|
||||
if OpenDialog.Execute then begin
|
||||
LoadFile(OpenDialog.FileName);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TForm1.BtnNewClick(Sender: TObject);
|
||||
begin
|
||||
TabControl.Tabs.Clear;
|
||||
Grid.NewWorkbook(26, 100);
|
||||
end;
|
||||
|
||||
// Saves sheet in grid to file, overwriting existing file
|
||||
procedure TForm1.BtnSaveClick(Sender: TObject);
|
||||
var
|
||||
err: String;
|
||||
begin
|
||||
if Grid.Workbook = nil then
|
||||
exit;
|
||||
|
||||
if Grid.Workbook.Filename <>'' then begin
|
||||
SaveDialog.InitialDir := ExtractFileDir(Grid.Workbook.FileName);
|
||||
SaveDialog.FileName := ChangeFileExt(ExtractFileName(Grid.Workbook.FileName), '');
|
||||
end;
|
||||
|
||||
if SaveDialog.Execute then
|
||||
begin
|
||||
Screen.Cursor := crHourglass;
|
||||
try
|
||||
Grid.SaveToSpreadsheetFile(SaveDialog.FileName);
|
||||
finally
|
||||
Screen.Cursor := crDefault;
|
||||
// Show a message in case of error(s)
|
||||
err := Grid.Workbook.ErrorMsg;
|
||||
if err <> '' then
|
||||
MessageDlg(err, mtError, [mbOK], 0);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
// Loads first worksheet from file into grid
|
||||
procedure TForm1.LoadFile(const AFileName: String);
|
||||
var
|
||||
err: String;
|
||||
begin
|
||||
// Load file
|
||||
Screen.Cursor := crHourglass;
|
||||
try
|
||||
try
|
||||
// Load file into workbook and grid
|
||||
Grid.LoadFromSpreadsheetFile(UTF8ToSys(AFileName));
|
||||
|
||||
// Update user interface
|
||||
Caption := Format('fpsGrid - %s (%s)', [
|
||||
AFilename,
|
||||
GetFileFormatName(Grid.Workbook.FileFormat)
|
||||
]);
|
||||
|
||||
// Collect the sheet names in the Tabs of the TabControl for switching sheets.
|
||||
if Grid.Workbook.FileFormat <> sfExcel2 then
|
||||
begin
|
||||
Grid.GetSheets(TabControl.Tabs);
|
||||
TabControl.TabIndex := 0;
|
||||
end;
|
||||
except
|
||||
on E:Exception do begin
|
||||
// Empty worksheet instead of the loaded one
|
||||
Grid.NewWorkbook(26, 100);
|
||||
Caption := 'fpsGrid - no name';
|
||||
TabControl.Tabs.Clear;
|
||||
// Grab the error message
|
||||
Grid.Workbook.AddErrorMsg(E.Message);
|
||||
end;
|
||||
end;
|
||||
|
||||
finally
|
||||
Screen.Cursor := crDefault;
|
||||
|
||||
// Show a message in case of error(s)
|
||||
err := Grid.Workbook.ErrorMsg;
|
||||
if err <> '' then
|
||||
MessageDlg(err, mtError, [mbOK], 0);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TForm1.TabControlChange(Sender: TObject);
|
||||
begin
|
||||
Grid.SelectSheetByIndex(TabControl.TabIndex);
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
|
@ -0,0 +1,6 @@
|
||||
This project demonstrates use of the Lazarus grid component supplied with
|
||||
fpspreadsheet. It demonstrates only the basics; a more extensive example can
|
||||
be found in the spready demo.
|
||||
|
||||
The grid is created at run-time, therefore installation of the package
|
||||
laz_fpspreadsheet_visual is not required. Just compile and run...
|
@ -2828,7 +2828,7 @@ begin
|
||||
P := ARect.TopLeft;
|
||||
case AJustification of
|
||||
0: ts.Alignment := taLeftJustify;
|
||||
1: if FDrawingCell <> nil then
|
||||
1: if (FDrawingCell <> nil) and (FDrawingCell^.MergedNeighbors = []) then
|
||||
begin
|
||||
// Special treatment for overflowing cells: they must be centered
|
||||
// at their original column, not in the total enclosing rectangle.
|
||||
|
@ -1282,14 +1282,6 @@ begin
|
||||
inherited;
|
||||
end;
|
||||
|
||||
|
||||
var
|
||||
|
||||
|
||||
counter: Integer = 0;
|
||||
|
||||
|
||||
|
||||
function TsSpreadBIFF8Reader.ReadWideString(const AStream: TStream;
|
||||
const ALength: WORD): WideString;
|
||||
var
|
||||
@ -1332,11 +1324,6 @@ begin
|
||||
end else begin
|
||||
//String is 1 byte per char, this is UTF-16 with the high byte ommited because it is zero
|
||||
//so decompress and then convert
|
||||
|
||||
|
||||
inc(Counter);
|
||||
|
||||
|
||||
lLen:=ALength;
|
||||
SetLength(DecomprStrValue, lLen);
|
||||
for i := 1 to lLen do
|
||||
|
Reference in New Issue
Block a user