paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-27 11:50:26 +02:00
Code Issues Packages Projects Releases Wiki Activity

LazReport: Fix paint ButtonControl, fix reorder designer pages, fix export to PDF. Issue #31941, patch from Lagunov Aleksey.

Browse Source 
git-svn-id: trunk@56674 -
This commit is contained in:
juha 2017-12-08 23:35:50 +00:00
parent 0f1a653071
commit a11668995f
4 changed files with 76 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
components/lazreport/source/addons/DialogControls/lrdialogcontrols.pas
View File

@ -736,11 +736,12 @@ end;
procedure TlrButtonPanel.PaintDesignControl;
var
AY, AX, aH, aW:integer;
AY, AX, aH, aW, W1:integer;
R1:TRect;
i:TPanelButton;
B:TPanelBitBtn;
TR: TTextStyle;
begin
AY:=(DRect.Top + DRect.Bottom) div 2;
aH:=Canvas.TextHeight(Text) div 2;
@ -768,7 +769,13 @@ begin
end;
if Assigned(B) then
begin
R1.Left:=R1.Right - B.Width;
if B.Width <= 0 then
W1:=75
else
W1:=B.Width;
R1.Left:=R1.Right - W1;
DrawFrameControl(Canvas.Handle, R1, DFC_BUTTON, DFCS_BUTTONPUSH);
AX:=(R1.Left + R1.Right) div 2;
@ -776,10 +783,13 @@ begin
aW:=Canvas.TextWidth(B.Caption);
aH:=Canvas.TextHeight(B.Caption) div 2;
if aW>B.Width then
Canvas.TextRect(R1, 0, AY - aH, B.Caption)
FillChar(TR,SizeOf(TR),0);
TR.ShowPrefix := true;
if aW>W1 then
Canvas.TextRect(R1, 0, AY - aH, B.Caption, TR)
else
Canvas.TextRect(R1, AX - (aW div 2), AY - aH, B.Caption)
Canvas.TextRect(R1, AX - (aW div 2), AY - aH, B.Caption, TR)
end;
R1.Right:=R1.Left - 6;

34
components/lazreport/source/addons/lrFclPDFExport/lr_e_fclpdf.pas
View File

@ -210,10 +210,28 @@ begin
FList.Clear;
end;
function MakePSName(AFontName: string; AFontStyle: TFontStyles):string;
begin
Result:=AFontName;
if Graphics.fsBold in AFontStyle then
Result:=Result + '-Bold';
if Graphics.fsItalic in AFontStyle then
Result:=Result + '-Oblique';
if Graphics.fsUnderline in AFontStyle then
Result:=Result + '-Underline';
if Graphics.fsStrikeOut in AFontStyle then
Result:=Result + '-StrikeOut';
end;
function TExportFonts.AddItem(AFontName: string; AFontStyle: TFontStyles
): TExportFontItem;
var
S1, S2, S3: String;
S1, S2, S3, S: String;
begin
Result:=FindItem(AFontName, AFontStyle);
if Assigned(Result) then exit;
@ -225,7 +243,8 @@ begin
S2:=ExtractFileName(Result.FTTFFontInfo.FileName);
S3:=AFontName;
FOwner.FPDFDocument.FontDirectory:=S1;
Result.FPdfFont:=FOwner.FPDFDocument.AddFont(S2, S3);
S:=MakePSName(AFontName, AFontStyle);
Result.FPdfFont:=FOwner.FPDFDocument.AddFont(S2, S);
end
else
Result:=FDefaultFontNormal;
@ -375,7 +394,11 @@ begin
{$IF (FPC_FULLVERSION >= 30101)}
gTTFontCache.BuildFontCacheIgnoresErrors:=true;
{$ENDIF}
{$IFDEF WINDOWS}
CreateFontDirList;
{$ELSE}
gTTFontCache.ReadStandardFonts;
{$ENDIF}
gTTFontCache.BuildFontCache;
end;
end;
@ -870,12 +893,11 @@ begin
FPDFDocument.Infos.ApplicationName := ApplicationName;
FPDFDocument.Infos.CreationDate := Now;
// FPDFDocument.Options:=FPdfOptions.FOptions;
FPDFDocument.Options:=FPDFDocument.Options + [poPageOriginAtTop];
FPDFDocument.DefaultOrientation := ppoPortrait; // FPdfOptions.PaperOrientation;
FPDFDocument.Options:=FPDFDocument.Options + [poPageOriginAtTop, poUseRawJPEG];
FPDFDocument.DefaultOrientation := ppoPortrait;
FPDFDocument.StartDocument;
FCurSection := FPDFDocument.Sections.AddSection; // we always need at least one section
FCurSection := FPDFDocument.Sections.AddSection;
SetupFonts;
end;

17
components/lazreport/source/lr_class.pas
View File

@ -91,11 +91,14 @@ type
TfrFrameBorders = set of TfrFrameBorder;
TfrFrameStyle = (frsSolid,frsDash, frsDot, frsDashDot, frsDashDotDot,frsDouble);
TfrPageType = (ptReport, ptDialog); //todo: - remove this
TfrReportOption = (roIgnoreFieldNotFound, roIgnoreSymbolNotFound, roHideDefaultFilter,
roDontUpgradePreparedReport, // on saving an old prepared report don't update to current version
roSaveAndRestoreBookmarks, // try to save and later restore dataset bookmarks on building report
roPageHeaderBeforeReportTitle // PageHeader band is printed before ReportTitle band
roPageHeaderBeforeReportTitle, // PageHeader band is printed before ReportTitle band
roDisableCancelBuild // Disable cancel button in build progress form
);
TfrReportOptions = set of TfrReportOption;
TfrObjectType = (otlReportView, otlUIControl);
@ -1205,6 +1208,7 @@ type
procedure DoPrintReport(const PageNumbers: String; Copies: Integer);
procedure SetComments(const AValue: TStringList);
procedure SetPrinterTo(const PrnName: String);
procedure SetReportOptions(AValue: TfrReportOptions);
procedure SetScript(AValue: TfrScriptStrings);
procedure SetVars(Value: TStrings);
procedure ClearAttribs;
@ -1321,7 +1325,7 @@ type
property InitialZoom: TfrPreviewZoom read FInitialZoom write FInitialZoom;
property ModalPreview: Boolean read FModalPreview write FModalPreview default True;
property ModifyPrepared: Boolean read FModifyPrepared write FModifyPrepared default True;
property Options: TfrReportOptions read FReportOptions write FReportOptions;
property Options: TfrReportOptions read FReportOptions write SetReportOptions;
property Preview: TfrPreview read FPreview write FPreview;
property PreviewButtons: TfrPreviewButtons read FPreviewButtons write FPreviewButtons;
property RebuildPrinter: boolean read FRebuildPrinter write FRebuildPrinter default False;
@ -11624,6 +11628,15 @@ begin
{$endif}
end;
procedure TfrReport.SetReportOptions(AValue: TfrReportOptions);
begin
if FReportOptions=AValue then Exit;
FReportOptions:=AValue;
if Assigned(frProgressForm) then
frProgressForm.Button1.Enabled:=not (roDisableCancelBuild in FReportOptions);
end;
procedure TfrReport.SetScript(AValue: TfrScriptStrings);
begin
fScript.Assign(AValue);

25
components/lazreport/source/lr_desgn.pas
View File

@ -43,7 +43,7 @@ type
SaveAs: Boolean; var Saved: Boolean) of object;
TfrDesignerForm = class;
TlrTabEditControl = class(TCustomTabControl);
//TlrTabEditControl = class(TCustomTabControl);
{ TfrDesigner }
@ -634,7 +634,7 @@ type
procedure InplaceEditorMenuClick(Sender: TObject);
private
FTabMouseDown:boolean;
FTabsPage:TlrTabEditControl;
//FTabsPage:TlrTabEditControl;
procedure TabsEditDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
procedure TabsEditDragDrop(Sender, Source: TObject; X, Y: Integer);
procedure TabsEditMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
@ -2934,13 +2934,21 @@ begin
Panel7.Visible := false;
{$endif}
FTabsPage:=TlrTabEditControl((Tab1.Tabs as TTabControlNoteBookStrings).NoteBook);
{ FTabsPage:=TlrTabEditControl((Tab1.Tabs as TTabControlNoteBookStrings).NoteBook);
FTabsPage.DragMode:=dmManual;
FTabsPage.OnDragOver:=@TabsEditDragOver;
FTabsPage.OnDragDrop:=@TabsEditDragDrop;
FTabsPage.OnMouseDown:=@TabsEditMouseDown;
FTabsPage.OnMouseMove:=@TabsEditMouseMove;
FTabsPage.OnMouseUp:=@TabsEditMouseUp;
FTabsPage.OnMouseUp:=@TabsEditMouseUp;}
Tab1.DragMode:=dmManual;
Tab1.OnDragOver:=@TabsEditDragOver;
Tab1.OnDragDrop:=@TabsEditDragDrop;
Tab1.OnMouseDown:=@TabsEditMouseDown;
Tab1.OnMouseMove:=@TabsEditMouseMove;
Tab1.OnMouseUp:=@TabsEditMouseUp;
end;
destructor TfrDesignerForm.Destroy;
@ -4566,7 +4574,8 @@ end;
procedure TfrDesignerForm.TabsEditDragOver(Sender, Source: TObject; X,
Y: Integer; State: TDragState; var Accept: Boolean);
begin
Accept:=(Source = FTabsPage) and (FTabsPage.IndexOfPageAt(X, Y) <> Tab1.TabIndex);
//Accept:=(Source = FTabsPage) and (FTabsPage.IndexOfPageAt(X, Y) <> Tab1.TabIndex);
Accept:=(Source = Tab1) and (Tab1.IndexOfTabAt(X, Y) <> Tab1.TabIndex);
end;
procedure TfrDesignerForm.TabsEditDragDrop(Sender, Source: TObject; X,
@ -4574,7 +4583,8 @@ procedure TfrDesignerForm.TabsEditDragDrop(Sender, Source: TObject; X,
var
NewIndex: Integer;
begin
NewIndex:=FTabsPage.IndexOfPageAt(X, Y);
//NewIndex:=FTabsPage.IndexOfPageAt(X, Y);
NewIndex:=Tab1.IndexOfTabAt(X, Y);
//ShowMessageFmt('New index = %d', [NewIndex]);
if (NewIndex>-1) and (NewIndex < CurReport.Pages.Count) then
begin
@ -4600,7 +4610,8 @@ procedure TfrDesignerForm.TabsEditMouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
begin
if FTabMouseDown then
FTabsPage.BeginDrag(false);
//FTabsPage.BeginDrag(false);
Tab1.BeginDrag(false);
end;
procedure TfrDesignerForm.TabsEditMouseUp(Sender: TObject;