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

40
components/jvcllaz/examples/JvTimeFramework/tfmain.lfm
View File

@ -560,7 +560,7 @@ object MainForm: TMainForm
Left = 198
Height = 24
Hint = 'New Appointment'
Top = 8
Top = 7
Width = 24
NumGlyphs = 2
Images = ImageList
@ -824,7 +824,7 @@ object MainForm: TMainForm
ClientHeight = 25
ClientWidth = 445
TabOrder = 2
object Label1: TLabel
object IconsProvidedLabel: TLabel
AnchorSideLeft.Control = Panel2
AnchorSideTop.Control = Panel2
Left = 5
@ -835,10 +835,10 @@ object MainForm: TMainForm
Caption = 'Icons provided by'
ParentColor = False
end
object Label2: TLabel
AnchorSideLeft.Control = Label1
object IconsLink: TLabel
AnchorSideLeft.Control = IconsProvidedLabel
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = Label1
AnchorSideTop.Control = IconsProvidedLabel
AnchorSideTop.Side = asrCenter
Left = 103
Height = 15
@ -849,9 +849,9 @@ object MainForm: TMainForm
Font.Color = clBlue
ParentColor = False
ParentFont = False
OnClick = Label2Click
OnMouseEnter = Label2MouseEnter
OnMouseLeave = Label2MouseLeave
OnClick = IconsLinkClick
OnMouseEnter = IconsLinkMouseEnter
OnMouseLeave = IconsLinkMouseLeave
end
end
object utfScheduleManager1: TJvTFScheduleManager
@ -871,7 +871,7 @@ object MainForm: TMainForm
end
object StateImageList: TImageList
left = 112
top = 280
top = 248
Bitmap = {
4C69040000001000000010000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
@ -1116,33 +1116,33 @@ object MainForm: TMainForm
ShowStartEndTimeInHint = False
LineSpacing = 2
left = 304
top = 144
top = 136
end
object GlanceTextViewer2: TJvTFGlanceTextViewer
ShowStartEndTimeInHint = False
LineSpacing = 2
ShowStartEnd = False
left = 304
top = 200
top = 192
end
object dbUTF: TSQLite3Connection
Connected = False
LoginPrompt = False
KeepConnection = False
Transaction = SQLTransaction
left = 104
top = 384
left = 96
top = 328
end
object SQLTransaction: TSQLTransaction
Active = False
Action = caCommit
Database = dbUTF
left = 100
top = 440
left = 96
top = 384
end
object ImageList: TImageList
left = 112
top = 211
top = 192
Bitmap = {
4C69070000001000000010000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000000000005A3B261C0000
@ -1546,7 +1546,11 @@ object MainForm: TMainForm
OnApptProgress = JvTFDaysPrinter1ApptProgress
GridStartTime = 0
GridEndTime = 0
left = 304
top = 259
left = 352
top = 248
end
object PrintDialog: TPrintDialog
left = 256
top = 248
end
end

40
components/jvcllaz/examples/JvTimeFramework/tfmain.pas
View File

@ -34,8 +34,9 @@ uses
LCLIntf,
SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Db, sqldb, sqlite3conn, //DBTables,
ComCtrls, StdCtrls, Buttons, ExtCtrls, ImgList, DateTimePicker, JvTFManager,
JvTFDays, JvTFGlance, JvTFGlanceTextViewer, JvTFMonths, JvTFWeeks;
ComCtrls, StdCtrls, Buttons, ExtCtrls, ImgList, DateTimePicker, PrintersDlgs,
JvTFManager, JvTFDays, JvTFGlance, JvTFGlanceTextViewer, JvTFMonths,
JvTFWeeks;
type
@ -44,9 +45,10 @@ type
TMainForm = class(TForm)
ImageList: TImageList;
JvTFDaysPrinter1: TJvTFDaysPrinter;
Label1: TLabel;
Label2: TLabel;
IconsProvidedLabel: TLabel;
IconsLink: TLabel;
Panel2: TPanel;
PrintDialog: TPrintDialog;
utfScheduleManager1: TJvTFScheduleManager;
StateImageList: TImageList;
NeedApptsQuery: TSQLQuery;
@ -81,12 +83,11 @@ type
PrintButton: TBitBtn;
dbUTF: TSQLite3Connection;
SQLTransaction: TSQLTransaction;
procedure Label2Click(Sender: TObject);
procedure Label2MouseEnter(Sender: TObject);
procedure Label2MouseLeave(Sender: TObject);
procedure utfScheduleManager1PostAppt(Sender: TObject; Appt: TJvTFAppt);
procedure utfScheduleManager1DeleteAppt(Sender: TObject; Appt: TJvTFAppt);
procedure utfScheduleManager1RefreshAppt(Sender: TObject; Appt: TJvTFAppt);
procedure IconsLinkClick(Sender: TObject);
procedure IconsLinkMouseEnter(Sender: TObject);
procedure IconsLinkMouseLeave(Sender: TObject);
procedure ModeComboChange(Sender: TObject);
procedure ViewSchedsButtonClick(Sender: TObject);
procedure HideSchedButtonClick(Sender: TObject);
@ -103,10 +104,12 @@ type
procedure NewApptButtonClick(Sender: TObject);
procedure EditApptButtonClick(Sender: TObject);
procedure DeleteApptButtonClick(Sender: TObject);
procedure JvTFDays1DateChanging(Sender: TObject; var NewDate: TDate);
procedure JvTFDays1DateChanged(Sender: TObject);
procedure JvTFDays1GranularityChanged(Sender: TObject);
procedure JvTFDays1DblClick(Sender: TObject);
procedure JvTFDaysPrinter1ApptProgress(Sender: TObject; Current,
Total: Integer);
procedure JvTFDaysPrinter1AssembleProgress(Sender: TObject; Current,
@ -116,11 +119,15 @@ type
procedure utfScheduleManager1LoadBatch(Sender: TObject; BatchName: String;
BatchStartDate, BatchEndDate: TDate);
procedure utfScheduleManager1DeleteAppt(Sender: TObject; Appt: TJvTFAppt);
procedure utfScheduleManager1PostAppt(Sender: TObject; Appt: TJvTFAppt);
procedure utfScheduleManager1RefreshAppt(Sender: TObject; Appt: TJvTFAppt);
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure PrintButtonClick(Sender: TObject);
private
{ Private declarations }
public
@ -577,6 +584,9 @@ end;
procedure TMainForm.PrintButtonClick(Sender: TObject);
begin
if not PrintDialog.Execute then
exit;
with JvTFDaysPrinter1 do
begin
// "Copy" the display properties from the JvTFDays control
@ -626,20 +636,20 @@ begin
PrintProgress.ProgressBar1.Position := Current;
end;
procedure TMainForm.Label2Click(Sender: TObject);
procedure TMainForm.IconsLinkClick(Sender: TObject);
begin
OpenURL('https://icons8.com');
end;
procedure TMainForm.Label2MouseEnter(Sender: TObject);
procedure TMainForm.IconsLinkMouseEnter(Sender: TObject);
begin
Label2.Font.Style := Label2.Font.Style + [fsUnderline];
IconsLink.Font.Style := IconsLink.Font.Style + [fsUnderline];
Screen.Cursor := crHandPoint;
end;
procedure TMainForm.Label2MouseLeave(Sender: TObject);
procedure TMainForm.IconsLinkMouseLeave(Sender: TObject);
begin
Label2.Font.Style := Label2.Font.Style - [fsUnderline];
IconsLink.Font.Style := IconsLink.Font.Style - [fsUnderline];
Screen.Cursor := crDefault;
end;

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.