unit PrintF;
{Печатает TLabel, TEdit, TMemo, TStringGrid, TShape и др. DB-компоненты.
Установите Form H & V ScrollBar.Ranges на 768X1008 для страницы 8X10.5.
Примечание: это не компонент. Успехов. Bill}interfaceuses
SysUtils, WinTypes, WinProcs, Classes, Graphics, Controls,
Forms, Grids, Printers, StdCtrls, ExtCtrls, Mask;
function PrintForm(AForm: TForm; ATag: Longint): integer;
{используйте: PrintForm(Form2, 0);
AForm - форма, которую необходимо напечатать. Если вы, к примеру,
печатаете Form2 из обработчика события Form1, то используйте Unit2
в списке используемых модулей в секции implementation молуля Unit1.
ATag - поле Tag компонента, который необходимо печатать или 0 для всех.
Если Tag компонента равен 14 (2+4+8), он буден напечатан в случае,
когда ATag равен 0, 2, 4 или 8.
Функция возвращает количество напечатанных компонентов. }implementationvar
ScaleX, ScaleY, I, Count: integer;
DC: HDC;
F: TForm;
function ScaleToPrinter(R: TRect): TRect;
begin
R.Top := (R.Top + F.VertScrollBar.Position) * ScaleY;
R.Left := (R.Left + F.HorzScrollBar.Position) * ScaleX;
R.Bottom := (R.Bottom + F.VertScrollBar.Position) * ScaleY;
R.Right := (R.Right + F.HorzScrollBar.Position) * ScaleY;
Result := R;
end;
procedure PrintMComponent(MC: TMemo);
var
C: array[0..255] of char;
CLen: integer;
Format: Word;
R: TRect;
begin
Printer.Canvas.Font := MC.Font;
DC := Printer.Canvas.Handle; {так DrawText знает о шрифте}
R := ScaleToPrinter(MC.BoundsRect);
if (not (F.Components[I] is TCustomLabel)) and (MC.BorderStyle = bsSingle)
then
Printer.Canvas.Rectangle(R.Left, R.Top, R.Right, R.Bottom);
Format := DT_LEFT;
if (F.Components[I] is TEdit) or (F.Components[I] is TCustomMaskEdit) then
Format := Format or DT_SINGLELINE or DT_VCENTER
elsebeginif MC.WordWrap then
Format := DT_WORDBREAK;
if MC.Alignment = taCenter then
Format := Format or DT_CENTER;
if MC.Alignment = taRightJustify then
Format := Format or DT_RIGHT;
R.Bottom := R.Bottom + Printer.Canvas.Font.Height;
end;
CLen := MC.GetTextBuf(C, 255);
R.Left := R.Left + ScaleX + ScaleX;
WinProcs.DrawText(DC, C, CLen, R, Format);
inc(Count);
end;
procedure PrintShape(SC: TShape);
var
H, W, S: integer;
R: TRect;
begin{PrintShape}
Printer.Canvas.Pen := SC.Pen;
Printer.Canvas.Pen.Width := Printer.Canvas.Pen.Width * ScaleX;
Printer.Canvas.Brush := SC.Brush;
R := ScaleToPrinter(SC.BoundsRect);
W := R.Right - R.Left;
H := R.Bottom - R.Top;
if W < H then
S := W
else
S := H;
if SC.Shape in [stSquare, stRoundSquare, stCircle] thenbegin
Inc(R.Left, (W - S) div 2);
Inc(R.Top, (H - S) div 2);
W := S;
H := S;
end;
case SC.Shape of
stRectangle, stSquare:
Printer.Canvas.Rectangle(R.Left, R.Top, R.Left + W, R.Top + H);
stRoundRect, stRoundSquare:
Printer.Canvas.RoundRect(R.Left, R.Top, R.Left + W, R.Top + H, S div 4, S
div 4);
stCircle, stEllipse:
Printer.Canvas.Ellipse(R.Left, R.Top, R.Left + W, R.Top + H);
end;
Printer.Canvas.Pen.Width := ScaleX;
Printer.Canvas.Brush.Style := bsClear;
inc(Count);
end; {PrintShape}procedure PrintSGrid(SGC: TStringGrid);
var
J, K: integer;
Q, R: TRect;
Format: Word;
C: array[0..255] of char;
CLen: integer;
begin
Printer.Canvas.Font := SGC.Font;
DC := Printer.Canvas.Handle; {так DrawText знает о шрифте}
Format := DT_SINGLELINE or DT_VCENTER;
Q := SGC.BoundsRect;
Printer.Canvas.Pen.Width := SGC.GridLineWidth * ScaleX;
for J := 0 to SGC.ColCount - 1 dofor K := 0 to SGC.RowCount - 1 dobegin
R := SGC.CellRect(J, K);
if R.Right > R.Left thenbegin
R.Left := R.Left + Q.Left;
R.Right := R.Right + Q.Left + SGC.GridLineWidth;
R.Top := R.Top + Q.Top;
R.Bottom := R.Bottom + Q.Top + SGC.GridLineWidth;
R := ScaleToPrinter(R);
if (J < SGC.FixedCols) or (K < SGC.FixedRows) then
Printer.Canvas.Brush.Color := SGC.FixedColor
else
Printer.Canvas.Brush.Style := bsClear;
if SGC.GridLineWidth > 0 then
Printer.Canvas.Rectangle(R.Left, R.Top, R.Right, R.Bottom);
StrPCopy(C, SGC.Cells[J, K]);
R.Left := R.Left + ScaleX + ScaleX;
WinProcs.DrawText(DC, C, StrLen(C), R, Format);
end;
end;
Printer.Canvas.Pen.Width := ScaleX;
inc(Count);
end;
function PrintForm(AForm: TForm; ATag: Longint): integer;
begin{PrintForm}
Count := 0;
F := AForm;
Printer.BeginDoc;
try
DC := Printer.Canvas.Handle;
ScaleX := WinProcs.GetDeviceCaps(DC, LOGPIXELSX) div F.PixelsPerInch;
ScaleY := WinProcs.GetDeviceCaps(DC, LOGPIXELSY) div F.PixelsPerInch;
for I := 0 to F.ComponentCount - 1 doif TControl(F.Components[I]).Visible thenif (ATag = 0) or (TControl(F.Components[I]).Tag and ATag = ATag) thenbeginif (F.Components[I] is TCustomLabel) or (F.Components[I] is
TCustomEdit) then
PrintMComponent(TMemo(F.Components[I]));
if (F.Components[I] is TShape) then
PrintShape(TShape(F.Components[I]));
if (F.Components[I] is TStringGrid) then
PrintSGrid(TStringGrid(F.Components[I]));
end;
finally
Printer.EndDoc;
Result := Count;
end;
end; {PrintForm}end.
unit Rulers;
{ Добавьте в файл .DCR иконки для двух компонентов.
Успехов, Bill}interfaceuses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms;
type
THRuler = class(TGraphicControl)
private{ Private declarations }
fHRulerAlign: TAlign;
procedure SetHRulerAlign(Value: TAlign);
protected{ Protected declarations }procedure Paint; override;
public{ Public declarations }constructor Create(AOwner: TComponent); override;
published{ Published declarations }property AlignHRuler: TAlign read fHRulerAlign write SetHRulerAlign default
alNone;
property Color default clYellow;
property Height default 33;
property Width default 768;
property Visible;
end;
type
TVRuler = class(TGraphicControl)
private{ Private declarations }
fVRulerAlign: TAlign;
procedure SetVRulerAlign(Value: TAlign);
protected{ Protected declarations }procedure Paint; override;
public{ Public declarations }constructor Create(AOwner: TComponent); override;
published{ Published declarations }property AlignVRuler: TAlign read fVRulerAlign write SetVRulerAlign default
alNone;
property Color default clYellow;
property Height default 1008;
property Width default 33;
property Visible;
end;
procedureRegister;
implementationprocedureRegister;
begin
RegisterComponents('Samples', [THRuler, TVRuler]);
end;
procedure THRuler.SetHRulerAlign(Value: TAlign);
beginif Value in [alTop, alBottom, alNone] thenbegin
fHRulerAlign := Value;
Align := Value;
end;
end;
constructor THRuler.Create(AOwner: TComponent);
begininherited Create(AOwner);
AlignHRuler := alNone;
Color := clYellow;
Height := 33;
Width := 768;
end;
procedure THRuler.Paint;
var
a12th, N, X: word;
begin
a12th := Screen.PixelsPerInch div 12;
N := 0;
X := 0;
with Canvas dobegin
Brush.Color := Color;
FillRect(ClientRect);
with ClientRect do
Rectangle(Left, Top, Right, Bottom);
while X < Width dobegin
MoveTo(X, 1);
LineTo(X, 6 * (1 + byte(N mod 3 = 0) +
byte(N mod 6 = 0) +
byte(N mod 12 = 0)));
if (N > 0) and (N mod 12 = 0) then
TextOut(PenPos.X + 3, 9, IntToStr(N div 12));
N := N + 1;
X := X + a12th;
end;
end;
end;
{*********************************************}procedure TVRuler.SetVRulerAlign(Value: TAlign);
beginif Value in [alLeft, alRight, alNone] thenbegin
fVRulerAlign := Value;
Align := Value;
end;
end;
constructor TVRuler.Create(AOwner: TComponent);
begininherited Create(AOwner);
AlignVRuler := alNone;
Color := clYellow;
Height := 1008;
Width := 33;
end;
procedure TVRuler.Paint;
var
a6th, N, Y: word;
begin
a6th := Screen.PixelsPerInch div 6;
N := 0;
Y := 0;
with Canvas dobegin
Brush.Color := Color;
FillRect(ClientRect);
with ClientRect do
Rectangle(Left, Top, Right, Bottom);
while Y < Height dobegin
MoveTo(1, Y);
LineTo(6 * (2 + byte(N mod 3 = 0) +
byte(N mod 6 = 0)), Y);
if (N > 0) and (N mod 6 = 0) then
TextOut(12, PenPos.Y - 16, IntToStr(N div 6));
N := N + 1;
Y := Y + a6th;
end;
end;
end;
end.
Это реализация функции печати формы в Delphi, которая позволяет печатать содержимое объекта TForm. Функция называется PrintForm и принимает два параметра: AForm, который является объектом TForm для печати, и ATag, который является значением тега, которое можно использовать для фильтрации компонентов для печати.
Функция сначала инициализирует некоторые переменные и настраивает канвас принтера. Затем она проходит по всем компонентам в форме, проверяет, если они видимы, и если их тег соответствует указанному значению ATag. Если обе условия истинны, она вызывает вспомогательную процедуру для печати каждого компонента.
Существуют три типа компонентов, которые можно печатать: TLabel, TEdit, TMemo, TStringGrid и TShape. Каждый тип имеет свою собственную процедуру печати, которая вызывается функцией PrintForm.
Процедуры печати используют объект Printer.Canvas для рисования текста или графики на канвасе принтера. Например, процедура PrintMemoComponent использует функцию DrawText для печати текста в компоненте TMemo, а процедура PrintShape использует функции Ellipse или Rectangle для рисования формы.
Процесс печати контролируется переменными ScaleX и ScaleY, которые используются для масштабирования графики на канвасе принтера. Это позволяет調грать размер печатаемого вывода в зависимости от разрешения принтера.
Наконец, функция заканчивает документ принтера и возвращает количество компонентов, которые были напечатаны.
Единица также содержит два custom-компонента: THRuler и TVRuler, которые используются как рульеры для печати. Эти компоненты имеют свойства, такие как AlignHRuler и AlignVRuler, которые контролируют их выравнивание на форме, а также процедуру Paint, которая вызывается для рисования линий и цифр.
Компонент THRuler имеет процедуру Paint, которая рисует горизонтальные линии и цифры на канвасе принтера. Компонент TVRuler имеет процедуру Paint, которая рисует вертикальные линии и цифры на канвасе принтера.
(Перевод с английского языка)
Печатает форму Delphi с возможностью настройки размеров и выравнивания элементов.
Комментарии и вопросы
Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS
Материалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта.