pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

jvcllaz: Activate printing in JvTimeFramework demo. Still issues with font size.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7100 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2019-08-07 22:43:50 +00:00
parent 41e17a30f3
commit 0436c5f2ce
7 changed files with 109 additions and 52 deletions
Download Patch File Download Diff File Expand all files Collapse all files

17
components/jvcllaz/run/JvTimeFramework/jvtfdays.pas
View File

@ -5610,6 +5610,7 @@ begin
try
GetApptDrawInfo(DrawInfo, Appt, Attr);
Font.Assign(DrawInfo.Font);
FixFont(Font);
Brush.Color := DrawInfo.Color;
Pen.Color := DrawInfo.FrameColor;
Pen.Width := DrawInfo.FrameWidth;
@ -6164,6 +6165,7 @@ begin
ACanvas.Brush.Color := UseAttr.Color;
ACanvas.Font.Assign(UseAttr.Font);
FixFont(ACanvas.Font);
DrawTxt(ACanvas, Rect, Txt, taCenter, vaCenter);
@ -6317,6 +6319,7 @@ begin
ACanvas.Brush.Color := HdrAttr.Color;
ACanvas.Font.Assign(HdrAttr.Font);
end;
FixFont(ACanvas.Font);
// All parameters now specified. Now calc text height.
Flags := DT_NOPREFIX or DT_WORDBREAK or DT_CENTER or DT_CALCRECT;
@ -6615,6 +6618,7 @@ begin
ACanvas.Font.Assign(SelFancyRowHdrAttr.MajorFont)
else
ACanvas.Font.Assign(FancyRowHdrAttr.MajorFont);
FixFont(ACanvas.Font);
ACanvas.Brush.Style := bsClear;
@ -6673,8 +6677,9 @@ begin
TxtRect.Bottom := TxtRect.Bottom - 2;
// now draw the LabelStr right aligned
ACanvas.Font.Assign(Attr.MinorFont);
ACanvas.Brush.Style := bsClear;
ACanvas.Font.Assign(Attr.MinorFont);
FixFont(ACanvas.Font);
// draw the focus rect if needed
if (RowNum = FocusedRow) and Focused and ShowFocus then
@ -6769,8 +6774,10 @@ begin
try
TempFont.Assign(Canvas.Font);
Canvas.Font.Assign(FancyRowHdrAttr.MinorFont);
FixFont(Canvas.Font);
Result := Canvas.TextWidth('22:22a') - 10;
Canvas.Font.Assign(TempFont);
FixFont(Canvas.Font);
finally
TempFont.Free;
end;
@ -9341,6 +9348,7 @@ begin
GetApptDrawInfo(DrawInfo, Appt, SelApptAttr);
FrameOffset := DrawInfo.FrameWidth div 2 * 2;
Canvas.Font := DrawInfo.Font;
FixFont(Canvas.Font);
FEditor.Font := DrawInfo.Font;
FEditor.Color := DrawInfo.Color;
finally
@ -10787,6 +10795,7 @@ begin
ACanvas.Brush.Color := UseAttr.Color;
ACanvas.Font.Assign(UseAttr.Font);
FixFont(ACanvas.Font);
Flags := DT_NOPREFIX or DT_CENTER;
case ColTitleStyle of
@ -13054,6 +13063,7 @@ begin
end;
ACanvas.Font.Assign(FancyRowHdrAttr.MajorFont);
FixFont(ACanvas.Font);
ACanvas.Brush.Style := bsClear;
DrawText(ACanvas.Handle, PChar(Lbl), -1, ARect,
@ -13164,6 +13174,7 @@ begin
// now draw the LabelStr right aligned
ACanvas.Font.Assign(FancyRowHdrAttr.MinorFont);
FixFont(ACanvas.Font);
ACanvas.Brush.Style := bsClear;
DrawText(ACanvas.Handle, PChar(LabelStr), -1, TxtRect,
@ -13193,6 +13204,7 @@ begin
ACanvas.Brush.Color := HdrAttr.Color;
ACanvas.Font.Assign(HdrAttr.Font);
FixFont(ACanvas.Font);
DrawTxt(ACanvas, ARect, Txt, taCenter, vaCenter);
@ -13433,8 +13445,10 @@ begin
try
TempFont.Assign(ACanvas.Font);
ACanvas.Font.Assign(FancyRowHdrAttr.MinorFont);
FixFont(ACanvas.Font);
Result := ACanvas.TextWidth('22:22a');
ACanvas.Font.Assign(TempFont);
FixFont(ACanvas.Font);
finally
TempFont.Free;
end;
@ -13935,6 +13949,7 @@ begin
ACanvas.Brush.Color := UseAttr.Color;
ACanvas.Font.Assign(UseAttr.Font);
FixFont(ACanvas.Font);
Flags := DT_NOPREFIX or DT_CENTER;
case ColTitleStyle of

1
components/jvcllaz/run/JvTimeFramework/jvtfglance.pas
View File

@ -2463,6 +2463,7 @@ begin
if Txt <> '' then
begin
ACanvas.Font := Attr.TitleAttr.DayTxtAttr.Font;
FixFont(ACanvas.Font);
DrawAngleText(ACanvas, AdjTitleRect, TextBounds,
Attr.TitleAttr.DayTxtAttr.Rotation,
Attr.TitleAttr.DayTxtAttr.AlignH,

1
components/jvcllaz/run/JvTimeFramework/jvtfglancetextviewer.pas
View File

@ -427,6 +427,7 @@ begin
//Font.Assign(Viewer.Font);
Font.Assign(DrawInfo.Font);
Self.Canvas.Font.Assign(DrawInfo.Font);
FixFont(Self.Canvas.Font);
RegBrushColor := Brush.Color;
RegFontColor := Font.Color;

49
components/jvcllaz/run/JvTimeFramework/jvtfmanager.pas
View File

@ -877,9 +877,7 @@ type
FOnMarginError: TNotifyEvent;
FTitle: string;
FDirectPrint: Boolean;
{ wp --- to do
function GetPage(Index: Integer): TMetafile;
}
function GetPage(Index: Integer): TBitmap; //was: TMetafile;
function GetBodyHeight: Integer; // always in pixels
function GetBodyWidth: Integer; // always in pixels
function GetBodyLeft: Integer; // always in pixels
@ -921,15 +919,14 @@ type
procedure NewDoc; dynamic;
property DirectPrint: Boolean read FDirectPrint write SetDirectPrint
default False;
public
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property PageCount: Integer read GetPageCount;
{ wp --- to do
property Pages[Index: Integer]: TMetafile read GetPage;
}
property Pages[Index: Integer]: TBitmap read GetPage; // was: TMetaFile
function ConvertMeasure(Value: Integer; FromMeasure,
ToMeasure: TJvTFPrinterMeasure; Horizontal: Boolean): Integer;
function ScreenToPrinter(Value: Integer; Horizontal: Boolean): Integer;
@ -4564,18 +4561,16 @@ begin
end;
end;
{ wp --- to do
function TJvTFPrinter.GetPage(Index: Integer): TMetafile;
function TJvTFPrinter.GetPage(Index: Integer): TBitmap; // was: TMetafile;
begin
if DirectPrint then
raise EJvTFPrinterError.CreateRes(@RsEDocumentPagesCannotBeAccessedIf);
if State <> spsFinished then
raise EJvTFPrinterError.CreateRes(@RsEDocumentPagesAreInaccessibleUntil);
Result := TMetafile(FPages.Objects[Index]);
// Result := TMetafile(FPages.Objects[Index]);
Result := TBitmap(FPages.Objects[Index]);
end;
}
function TJvTFPrinter.GetPageCount: Integer;
begin
@ -4672,13 +4667,16 @@ var
{ wp --- to do
aMetafile: TMetafile;
}
aBitmap: TBitmap;
aCanvas: TCanvas;
HeaderRect, FooterRect: TRect;
begin
if Aborted then
Exit;
{ wp --- to do
if DirectPrint then
begin
if PageCount > 0 then
@ -4688,6 +4686,16 @@ begin
end
else
begin
// Create a TBitmap for the page
aBitmap := TBitmap.Create;
aBitmap.SetSize(Printer.PaperSize.Width, Printer.PaperSize.Height);
aBitmap.Canvas.Brush.Color := clWhite;
aBitmap.Canvas.FillRect(0, 0, aBitmap.Width, aBitmap.Height);
FPages.AddObject('', aBitmap);
// Store the canvas in FBodies so we can retrieve it later to draw
// the header and footer.
aCanvas := aBitmap.Canvas;
{
// Create a TMetafile for the page
aMetafile := TMetafile.Create;
FPages.AddObject('', aMetafile);
@ -4695,22 +4703,27 @@ begin
// Store the canvas in FBodies so we can retrieve it later to draw
// the header and footer.
aCanvas := TMetafileCanvas.Create(aMetafile, Printer.Handle);
}
end;
FBodies.AddObject('', aCanvas);
aCanvas.Font.PixelsPerInch := Windows.GetDeviceCaps(Printer.Handle,
LOGPIXELSX);
//aCanvas.Font.PixelsPerInch := Printer.XDPI;
FixFont(aCanvas.Font);
{
aCanvas.Font.PixelsPerInch := Windows.GetDeviceCaps(Printer.Handle, LOGPIXELSX);
}
Windows.SetViewPortOrgEx(aCanvas.Handle, BodyLeft, BodyTop, nil);
LCLIntf.SetViewportOrgEx(aCanvas.Handle, BodyLeft, BodyTop, nil);
// Windows.SetViewPortOrgEx(aCanvas.Handle, BodyLeft, BodyTop, nil);
DrawBody(aCanvas, Rect(BodyLeft, BodyTop, BodyWidth - BodyLeft,
BodyHeight - BodyTop), FPages.Count);
Windows.SetViewPortOrgEx(aCanvas.Handle, 0, 0, nil);
LCLIntf.SetViewPortOrgEx(aCanvas.Handle, 0, 0, nil);
// Windows.SetViewPortOrgEx(aCanvas.Handle, 0, 0, nil);
if DirectPrint then
begin
GetHeaderFooterRects(HeaderRect, FooterRect);
DrawHeader(aCanvas, HeaderRect, PageCount);
DrawFooter(aCanvas, FooterRect, PageCount);
end;
}
end;
procedure TJvTFPrinter.Print;

13
components/jvcllaz/run/JvTimeFramework/jvtfutils.pas
View File

@ -120,6 +120,9 @@ function IsClassByName(Obj: TObject; ClassName: string): Boolean;
function StringsToStr(const List: TStrings; const Sep: string;
const AllowEmptyString: Boolean = True): string;
procedure FixFont(const AFont: TFont);
implementation
uses
@ -824,4 +827,14 @@ begin
end;
end;
{ Fix Lazarus default font size of 0 }
procedure FixFont(const AFont: TFont);
begin
if AFont.Height = 0 then
AFont.Size := abs(GetFontData(AFont.Reference.Handle).Height) * 72 div AFont.PixelsPerInch;
end;
end.