MathgeomGLS

1
unit fPrint;
2

3
interface
4

5
uses
6
  Winapi.Windows,
7
  Winapi.Messages,
8
  System.SysUtils,
9
  System.Variants,
10
  System.Classes,
11
  Vcl.Graphics,
12
  Vcl.Controls,
13
  Vcl.Forms,
14
  Vcl.Dialogs,
15
  Vcl.StdCtrls,
16
  Vcl.Buttons,
17
  Vcl.ExtCtrls,
18
  Vcl.Printers,
19

20
  uGlobal;
21

22
type
23
  TPrintForm = class(TForm)
24
    Panel: TPanel;
25
    Label1: TLabel;
26
    Label2: TLabel;
27
    Label3: TLabel;
28
    Label4: TLabel;
29
    Label5: TLabel;
30
    EditScale: TEdit;
31
    EditLeft: TEdit;
32
    EditTop: TEdit;
33
    EditWidth: TEdit;
34
    EditHeight: TEdit;
35
    UnitRG: TRadioGroup;
36
    CloseBitBtn: TBitBtn;
37
    OKBitBtn: TBitBtn;
38
    Image: TImage;
39
    FitToPageButton: TSpeedButton;
40
    PageCentreButton: TSpeedButton;
41
    ColorDialog: TColorDialog;
42
    ColorButton: TSpeedButton;
43
    Label6: TLabel;
44
    EditBorder: TEdit;
45
    procedure FormCreate(Sender: TObject);
46
    procedure FormShow(Sender: TObject);
47
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
48
    procedure FloatKeyPress(Sender: TObject; var Key: Char);
49
    procedure ScaleKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
50
    procedure numKeyPress(Sender: TObject; var Key: Char);
51
    procedure LeftKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
52
    procedure TopKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
53
    procedure WidthKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
54
    procedure HeightKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
55
    procedure UnitRGClick(Sender: TObject);
56
    procedure FitToPageButtonClick(Sender: TObject);
57
    procedure PageCentreButtonClick(Sender: TObject);
58
    procedure ColorButtonClick(Sender: TObject);
59
    procedure CloseBitBtnClick(Sender: TObject);
60
    procedure EditBorderKeyPress(Sender: TObject; var Key: Char);
61
    procedure EditBorderKeyUp(Sender: TObject; var Key: Word;
62
                              Shift: TShiftState);
63
  private
64
    bmpScale: double;
65
    bmpLeft: integer;    { as pixels }
66
    bmpTop: integer;     { as pixels }
67
    bmpWidth: integer;   { as pixels }
68
    bmpHeight: integer;  { as pixels }
69
    BorderWidth: integer;
70
    BorderColor: TColor;
71
    vubmp: TBitMap;
72
    procedure PaintImage;
73
    procedure ShowData(Sender: TObject);
74
    function PixelTomm(const v, t: integer): double;
75
    function PixelTocm(const v, t: integer): double;
76
    function PixelToInch(const v, t: integer): double;
77
    function mmToPixel(const v: double; const t: integer): integer;
78
    function cmToPixel(const v: double; const t: integer): integer;
79
    function InchToPixel(const v: double; const t: integer): integer;
80
  end;
81

82
var
83
  PrintForm: TPrintForm;
84

85
//========================================================================
86
implementation
87
//========================================================================
88

89
uses
90
  fPlot1D;
91

92
{$R *.dfm}
93

94
procedure TPrintForm.FormCreate(Sender: TObject);
95
begin
96
  with Layout do
97
  begin
98
    if bmpScale = 0 then
99
    begin
100
      Left := (Screen.Width - Width) div 2;
101
      Top := (Screen.Height - Height) div 2;
102
      UnitRG.ItemIndex := 0;
103
      bmpScale := 1;
104
      BorderColor := ClRed;
105
      BorderWidth := 10;
106
    end
107
    else
108
    begin
109
      Left := PrintLeft;
110
      Top := PrintTop;
111
      UnitRG.ItemIndex := PrintUnit;
112
      bmpScale := PrintScale;
113
      BorderColor := PrintBorderColor;
114
      BorderWidth := PrintBorderWidth;
115
    end;
116
  end;
117

118
  bmpWidth := round(bmpScale*MainForm.GLViewer.Width);
119
  bmpHeight := round(bmpScale*MainForm.GLViewer.Height);
120

121
  ShowData(Sender);
122
  vubmp := TBitMap.Create;
123
  vubmp.Width := Image.Width;
124
  vubmp.Height := Image.Height;
125
end;
126

127
procedure TPrintForm.FormShow(Sender: TObject);
128
begin
129
  with MainForm.GLMemoryViewer do
130
  begin
131
    Width := vubmp.Width;
132
    Height := vubmp.Height;
133
    Buffer.BackgroundColor := GraphData.BackColor;
134
    Render;
135
    vubmp := Buffer.CreateSnapShotBitmap;
136
  end;
137
  UnitRG.SetFocus;
138
  UnitRG.ItemIndex := 0;
139
  UnitRGClick(Sender);
140
  EditScale.SetFocus;
141
end;
142

143
procedure TPrintForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
144
var
145
  BorderRect: TRect;
146
  GraphRect: TRect;
147
  bmp: TBitmap;
148

149
begin
150
  if ModalResult = mrOK then
151
  begin
152
    BorderRect := Rect(bmpLeft + BorderWidth div 2, bmpTop + BorderWidth div 2,
153
                       bmpLeft + bmpWidth - BorderWidth div 2 + 1,
154
                       bmpTop + bmpHeight - BorderWidth div 2 + 1);
155
    GraphRect := Rect(0, 0, bmpWidth - 2*BorderWidth,
156
                            bmpHeight - 2*BorderWidth);
157

158
    Printer.Title := MainForm.Caption;
159
    Printer.BeginDoc;
160
    bmp := TBitmap.Create;
161
    try
162
      bmp.PixelFormat := pf32bit;
163
    { bmp is a device-independent true-color 32 bits per pixel bitmap. }
164
      with GraphRect do
165
      begin
166
        bmp.Width := Right - Left;
167
        bmp.Height := Bottom - Top;
168
      end;
169

170
      with MainForm.GLMemoryViewer do
171
      begin
172
        Width := bmp.Width;
173
        Height := bmp.Height;
174
        Buffer.BackgroundColor := GraphData.BackColor;
175
        Render;
176
        bmp := Buffer.CreateSnapShotBitmap;
177
      end;
178

179
      Printer.Canvas.Pen.Color := BorderColor;
180
      Printer.Canvas.Pen.Width := BorderWidth;
181
      Printer.Canvas.Rectangle(BorderRect);
182
      Printer.Canvas.Draw(bmpLeft + BorderWidth, bmpTop + BorderWidth, bmp);
183
    finally
184
      Printer.EndDoc;
185
      bmp.Free;
186
    end;
187
  end;
188
  vubmp.Free;
189
  with Layout do
190
  begin
191
    PrintLeft := Left;
192
    PrintTop := Top;
193
    PrintUnit := UnitRG.ItemIndex;
194
    PrintScale := bmpScale;
195
    PrintBorderColor := BorderColor;
196
    PrintBorderWidth := BorderWidth;
197
  end;
198
end;
199

200
procedure TPrintForm.FloatKeyPress(Sender: TObject; var Key: Char);
201
begin
202
  with Sender as TEdit do
203
  if not CharInSet(Key, ['0'..'9', '.', #8]) then Key := #0
204
end;
205

206
procedure TPrintForm.ScaleKeyUp(Sender: TObject; var Key: Word;
207
                                Shift: TShiftState);
208
begin
209
  try
210
    bmpScale := StrToFloat(EditScale.Text);
211
  except
212
    bmpScale := 1.0;
213
  end;
214

215
  bmpWidth := round(bmpScale*MainForm.GLViewer.Width);
216
  if bmpWidth > PrinterInfo.xRes then
217
  begin
218
    bmpWidth := PrinterInfo.xRes;
219
    bmpScale := bmpWidth/MainForm.GLViewer.Width;
220
    bmpHeight := round(bmpScale*MainForm.GLViewer.Height);
221
    ShowData(Sender);
222
    Exit;
223
  end;
224

225
  bmpHeight := round(bmpScale*MainForm.GLViewer.Height);
226
  if bmpHeight > PrinterInfo.yRes then
227
  begin
228
    bmpHeight := PrinterInfo.yRes;
229
    bmpScale := bmpHeight/MainForm.GLViewer.Height;
230
    bmpWidth := round(bmpScale*MainForm.GLViewer.Width);
231
    ShowData(Sender);
232
    Exit;
233
  end;
234
  ShowData(Sender);
235
end;
236

237
procedure TPrintForm.numKeyPress(Sender: TObject; var Key: Char);
238
begin
239
  with Sender as TEdit do
240
  begin
241
    if UnitRG.ItemIndex = 0 then
242
    begin
243
      if not CharInSet(Key, ['0'..'9', #8]) then Key := #0
244
    end
245
    else if not CharInSet(Key, ['0'..'9', '.', #8]) then Key := #0
246
  end;
247
end;
248

249
procedure TPrintForm.LeftKeyUp(Sender: TObject; var Key: Word;
250
                               Shift: TShiftState);
251
var
252
  v: double;
253

254
begin
255
  try
256
    v := StrToFloat(EditLeft.Text);
257
  except
258
    v := 10;
259
  end;
260
  case UnitRG.ItemIndex of
261
  0:bmpLeft := round(v);
262
  1:bmpLeft := mmToPixel(v, 0);
263
  2:bmpLeft := cmToPixel(v, 0);
264
  3:bmpLeft := InchToPixel(v, 0);
265
  end;
266
  ShowData(Sender);
267
end;
268

269
procedure TPrintForm.TopKeyUp(Sender: TObject; var Key: Word;
270
                              Shift: TShiftState);
271
var
272
  v: double;
273

274
begin
275
  try
276
    v := StrToFloat(EditTop.Text);
277
  except
278
    v := 10;
279
  end;
280
  case UnitRG.ItemIndex of
281
  0:bmpTop := round(v);
282
  1:bmpTop := mmToPixel(v, 0);
283
  2:bmpTop := cmToPixel(v, 0);
284
  3:bmpTop := InchToPixel(v, 0);
285
  end;
286
  ShowData(Sender);
287
end;
288

289
procedure TPrintForm.WidthKeyUp(Sender: TObject; var Key: Word;
290
                                Shift: TShiftState);
291
var
292
  v: double;
293

294
begin
295
  try
296
    v := StrToFloat(EditWidth.Text);
297
  except
298
    v := bmpScale*MainForm.GLViewer.Width;
299
  end;
300
  case UnitRG.ItemIndex of
301
  0:bmpWidth := round(v);
302
  1:bmpWidth := mmToPixel(v, 0);
303
  2:bmpWidth := cmToPixel(v, 0);
304
  3:bmpWidth := InchToPixel(v, 0);
305
  end;
306
  if bmpWidth > PrinterInfo.xRes then
307
  begin
308
    bmpWidth := PrinterInfo.xRes;
309
  end;
310
  bmpScale := bmpWidth/MainForm.GLViewer.Width;
311
  bmpHeight := round(bmpScale*MainForm.GLViewer.Height);
312
  ShowData(Sender);
313
end;    { TPrintForm.WidthKeyUp }
314

315
procedure TPrintForm.HeightKeyUp(Sender: TObject; var Key: Word;
316
                                 Shift: TShiftState);
317
var
318
  v: double;
319

320
begin
321
  try
322
    v := StrToFloat(EditHeight.Text);
323
  except
324
    v := bmpScale*MainForm.GLViewer.Height;
325
  end;
326
  case UnitRG.ItemIndex of
327
  0:bmpHeight := round(v);
328
  1:bmpHeight := mmToPixel(v, 0);
329
  2:bmpHeight := cmToPixel(v, 0);
330
  3:bmpHeight := InchToPixel(v, 0);
331
  end;
332
  if bmpHeight > PrinterInfo.yRes then
333
  begin
334
    bmpHeight := PrinterInfo.yRes;
335
  end;
336
  bmpScale := bmpHeight/MainForm.GLViewer.Height;
337
  bmpWidth := round(bmpScale*MainForm.GLViewer.Width);
338
  ShowData(Sender);
339
end;
340

341
procedure TPrintForm.UnitRGClick(Sender: TObject);
342
begin
343
  ShowData(Sender);
344
end;
345

346
procedure TPrintForm.FitToPageButtonClick(Sender: TObject);
347
var
348
  i: integer;
349

350
begin
351
  UnitRG.SetFocus;
352
  i := UnitRG.ItemIndex;
353
  UnitRG.ItemIndex := 0;
354

355
  bmpScale := 1;
356
  bmpLeft := 0;
357
  bmpTop := 0;
358
  bmpHeight := MainForm.GLViewer.Height;
359
  bmpWidth := MainForm.GLViewer.Width;
360

361
  bmpWidth := Printer.PageWidth - 2*bmpLeft;
362
  bmpScale := bmpWidth/MainForm.GLViewer.Width;
363
  bmpHeight := round(bmpScale*MainForm.GLViewer.Height);
364

365
  if bmpHeight > Printer.PageHeight - 2*bmpTop then
366
  begin
367
    bmpHeight := Printer.PageHeight - 2*bmpTop;
368
    bmpScale := bmpHeight/MainForm.GLViewer.Height;
369
    bmpWidth := round(bmpScale*MainForm.GLViewer.Width);
370
  end;
371

372
  ShowData(Sender);
373
  UnitRG.SetFocus;
374
  UnitRG.ItemIndex := i
375
end;
376

377
procedure TPrintForm.PageCentreButtonClick(Sender: TObject);
378
var
379
  i: integer;
380

381
begin
382
  UnitRG.SetFocus;
383
  i := UnitRG.ItemIndex;
384
  UnitRG.ItemIndex := 0;
385
  if bmpLeft + bmpWidth > Printer.PageWidth then bmpLeft := 0;
386
  if bmpTop + bmpHeight > Printer.PageHeight then bmpTop := 0;
387
  if bmpWidth > Printer.PageWidth then
388
  begin
389
    bmpWidth := Printer.PageWidth;
390
    bmpScale := bmpWidth/MainForm.GLViewer.Width;
391
    bmpHeight := round(bmpScale*MainForm.GLViewer.Height);
392
  end;
393
  if bmpHeight > Printer.PageHeight then
394
  begin
395
    bmpHeight := Printer.PageHeight;
396
    bmpScale := bmpHeight/MainForm.GLViewer.Height;
397
    bmpWidth := round(bmpScale*MainForm.GLViewer.Width);
398
  end;
399
  bmpLeft := (Printer.PageWidth - bmpWidth) div 2;
400
  bmpTop := (Printer.PageHeight - bmpHeight) div 2;
401
  ShowData(Sender);
402
  UnitRG.SetFocus;
403
  UnitRG.ItemIndex := i
404
end;
405

406
procedure TPrintForm.ColorButtonClick(Sender: TObject);
407
begin
408
  ColorDialog.Color := BorderColor;
409
  if ColorDialog.Execute then
410
  begin
411
    BorderColor := ColorDialog.Color;
412
    PaintImage;
413
  end;
414
end;
415

416
procedure TPrintForm.EditBorderKeyPress(Sender: TObject; var Key: Char);
417
begin
418
  if not CharInSet(Key, ['0'..'9', #8]) then Key := #0
419
end;
420

421
procedure TPrintForm.EditBorderKeyUp(Sender: TObject; var Key: Word;
422
                                     Shift: TShiftState);
423
var
424
  v: integer;
425
begin
426
  try
427
    v := StrToInt(EditBorder.Text);
428
  except
429
    v := 10;
430
  end;
431
  BorderWidth := v;
432
  ShowData(Sender);
433
end;
434

435
procedure TPrintForm.PaintImage;
436
var
437
  PaperWidthPix: integer;
438
  PaperHeightPix: integer;
439
  PrintAreaWidthPix: integer;
440
  PrintAreaHeightPix: integer;
441
  dx, dy: integer;
442
  Scale: double;
443
  Shade: TRect;
444
  Paper: TRect;
445
  PrintArea: TRect;
446
  Graph: TRect;
447

448
begin
449
{ calculations }
450
  PaperWidthPix := PrinterInfo.xRes+2*PrinterInfo.xOffset;
451
  PaperHeightPix := PrinterInfo.yRes+2*PrinterInfo.yOffset;
452

453
  if PaperWidthPix > PaperHeightPix
454
  then Scale := 0.95*Image.Width/PaperWidthPix
455
  else Scale := 0.95*Image.Height/PaperHeightPix;
456

457
  PaperHeightPix := round(Scale*PaperHeightPix);
458
  PaperWidthPix := round(Scale*PaperWidthPix);
459

460
  PrintAreaWidthPix := round(Scale*PrinterInfo.xRes);
461
  PrintAreaHeightPix := round(Scale*PrinterInfo.yRes);
462

463
  Paper.Top := (Image.Height - PaperHeightPix) div 2 - 3;
464
  Paper.Left := (Image.Width - PaperWidthPix) div 2 - 3;
465
  Paper.Bottom := Paper.Top + PaperHeightPix;
466
  Paper.Right := Paper.Left + PaperWidthPix;
467

468
  dx := round(Scale*PrinterInfo.xOffset);
469
  dy := round(Scale*PrinterInfo.yOffset);
470

471
  PrintArea.Top := Paper.Top + dy;
472
  PrintArea.Left := Paper.Left + dx;
473
  PrintArea.Bottom := PrintArea.Top + PrintAreaHeightPix;
474
  PrintArea.Right := PrintArea.Left + PrintAreaWidthPix;
475

476
  Shade := Paper;
477
  Inc(Shade.Top, 6);
478
  Inc(Shade.Left, 6);
479
  Inc(Shade.Bottom, 6);
480
  Inc(Shade.Right, 6);
481

482
  if bmpWidth < 100 then bmpWidth := 100;
483
  if bmpHeight < 100 then bmpHeight := 100;
484

485
  Graph.Left := PrintArea.Left + round(Scale*bmpLeft);
486
  Graph.Top := PrintArea.Top + round(Scale*bmpTop);
487
  Graph.Right := Graph.Left + round(Scale*bmpWidth);
488
  Graph.Bottom := Graph.Top + round(Scale*bmpHeight);
489

490
  with Image.Canvas do
491
  begin
492
    with Brush do
493
    begin
494
      Style := bsSolid;
495
      Color := clCream;
496
    end;
497
    FillRect(Rect(0, 0, Image.Width, Image.Height));
498

499
    Brush.Color := clSilver;
500
    Pen.Color := clBlack;
501
    FillRect(Shade);
502

503
    Brush.Color := clWhite;
504
    FillRect(Paper);
505
    Rectangle(Paper);
506

507
    Pen.Color := clBlue;
508
    Rectangle(PrintArea);
509

510
    StretchDraw(Graph, vubmp);
511
    if BorderWidth > 0 then
512
    begin
513
      Brush.Color := BorderColor;
514
      FrameRect(Graph);
515
    end;
516
  end;
517
end;
518

519
procedure TPrintForm.ShowData(Sender: TObject);
520
  procedure TagIsZero;
521
  begin
522
    EditScale.Text := FloatToStrF(bmpScale, ffFixed, 6, 3);
523
    case UnitRg.ItemIndex of
524
    0:begin  { pixels }
525
        EditLeft.Text := IntToStr(bmpLeft);
526
        EditTop.Text := IntToStr(bmpTop);
527
        EditWidth.Text := IntToStr(bmpWidth);
528
        EditHeight.Text := IntToStr(bmpHeight);
529
      end;
530
    1:begin  { mm }
531
        EditLeft.Text :=
532
         FloatToStrF(PixelTomm(bmpLeft, 0), ffFixed, 6, 3);
533
        EditTop.Text :=
534
         FloatToStrF(PixelTomm(bmpTop, 0), ffFixed, 6, 3);
535
        EditWidth.Text :=
536
         FloatToStrF(PixelTomm(bmpWidth, 0), ffFixed, 6, 3);
537
        EditHeight.Text :=
538
         FloatToStrF(PixelTomm(bmpHeight, 0), ffFixed, 6, 3);
539
      end;
540
    2:begin  { cm }
541
        EditLeft.Text :=
542
         FloatToStrF(PixelTocm(bmpLeft, 0), ffFixed, 6, 3);
543
        EditTop.Text :=
544
         FloatToStrF(PixelTocm(bmpTop, 0), ffFixed, 6, 3);
545
        EditWidth.Text :=
546
         FloatToStrF(PixelTocm(bmpWidth, 0), ffFixed, 6, 3);
547
        EditHeight.Text :=
548
         FloatToStrF(PixelTocm(bmpHeight, 0), ffFixed, 6, 3);
549
      end;
550
    3:begin  { inch }
551
        EditLeft.Text :=
552
         FloatToStrF(PixelToInch(bmpLeft, 0), ffFixed, 6, 3);
553
        EditTop.Text :=
554
         FloatToStrF(PixelToInch(bmpTop, 0), ffFixed, 6, 3);
555
        EditWidth.Text :=
556
         FloatToStrF(PixelToInch(bmpWidth, 0), ffFixed, 6, 3);
557
        EditHeight.Text :=
558
         FloatToStrF(PixelToInch(bmpHeight, 0), ffFixed, 6, 3);
559
      end;
560
    end;
561
  end;    { TagIsZero }
562

563
begin
564
  if Sender is TEdit then
565
  begin
566
    with Sender as TEdit do
567
    case Tag of
568
    0:TagIsZero; { Factor etc. }
569
    1:begin  { Scale }
570
        case UnitRg.ItemIndex of
571
        0:begin  { pixels }
572
            EditLeft.Text := IntToStr(bmpLeft);
573
            EditTop.Text := IntToStr(bmpTop);
574
            EditWidth.Text := IntToStr(bmpWidth);
575
            EditHeight.Text := IntToStr(bmpHeight);
576
          end;
577
        1:begin  { mm }
578
            EditLeft.Text :=
579
             FloatToStrF(PixelTomm(bmpLeft, Tag), ffFixed, 6, 3);
580
            EditTop.Text :=
581
             FloatToStrF(PixelTomm(bmpTop, Tag), ffFixed, 6, 3);
582
            EditWidth.Text :=
583
             FloatToStrF(PixelTomm(bmpWidth, Tag), ffFixed, 6, 3);
584
            EditHeight.Text :=
585
             FloatToStrF(PixelTomm(bmpHeight, Tag), ffFixed, 6, 3);
586
          end;
587
        2:begin  { cm }
588
            EditLeft.Text :=
589
             FloatToStrF(PixelTocm(bmpLeft, Tag), ffFixed, 6, 3);
590
            EditTop.Text :=
591
             FloatToStrF(PixelTocm(bmpTop, Tag), ffFixed, 6, 3);
592
            EditWidth.Text :=
593
             FloatToStrF(PixelTocm(bmpWidth, Tag), ffFixed, 6, 3);
594
            EditHeight.Text :=
595
             FloatToStrF(PixelTocm(bmpHeight, Tag), ffFixed, 6, 3);
596
          end;
597
        3:begin  { inch }
598
            EditLeft.Text :=
599
             FloatToStrF(PixelToInch(bmpLeft, Tag), ffFixed, 6, 3);
600
            EditTop.Text :=
601
             FloatToStrF(PixelToInch(bmpTop, Tag), ffFixed, 6, 3);
602
            EditWidth.Text :=
603
             FloatToStrF(PixelToInch(bmpWidth, Tag), ffFixed, 6, 3);
604
            EditHeight.Text :=
605
             FloatToStrF(PixelToInch(bmpHeight, Tag), ffFixed, 6, 3);
606
          end;
607
        end;
608
      end;
609
    4:begin  { Width }
610
        EditScale.Text := FloatToStrF(bmpScale, ffFixed, 6, 3);
611
        case UnitRg.ItemIndex of
612
        0:EditHeight.Text := IntToStr(bmpHeight);
613
        1:begin  { mm }
614
            EditLeft.Text :=
615
             FloatToStrF(PixelTomm(bmpLeft, Tag), ffFixed, 6, 3);
616
            EditTop.Text :=
617
             FloatToStrF(PixelTomm(bmpTop, Tag), ffFixed, 6, 3);
618
            EditHeight.Text :=
619
             FloatToStrF(PixelTomm(bmpHeight, Tag), ffFixed, 6, 3);
620
          end;
621
        2:begin  { cm }
622
            EditLeft.Text :=
623
             FloatToStrF(PixelTocm(bmpLeft, Tag), ffFixed, 6, 3);
624
            EditTop.Text :=
625
             FloatToStrF(PixelTocm(bmpTop, Tag), ffFixed, 6, 3);
626
            EditHeight.Text :=
627
             FloatToStrF(PixelTocm(bmpHeight, Tag), ffFixed, 6, 3);
628
          end;
629
        3:begin  { inch }
630
            EditLeft.Text :=
631
             FloatToStrF(PixelToInch(bmpLeft, Tag), ffFixed, 6, 3);
632
            EditTop.Text :=
633
             FloatToStrF(PixelToInch(bmpTop, Tag), ffFixed, 6, 3);
634
            EditHeight.Text :=
635
             FloatToStrF(PixelToInch(bmpHeight, Tag), ffFixed, 6, 3);
636
          end;
637
        end;
638
      end;
639
    5:begin  { Height }
640
        EditScale.Text := FloatToStrF(bmpScale, ffFixed, 6, 3);
641
        case UnitRg.ItemIndex of
642
        0:EditWidth.Text := IntToStr(bmpWidth);
643
        1:begin  { mm }
644
            EditLeft.Text :=
645
             FloatToStrF(PixelTomm(bmpLeft, Tag), ffFixed, 6, 3);
646
            EditTop.Text :=
647
             FloatToStrF(PixelTomm(bmpTop, Tag), ffFixed, 6, 3);
648
            EditWidth.Text :=
649
             FloatToStrF(PixelTomm(bmpWidth, Tag), ffFixed, 6, 3);
650
          end;
651
        2:begin  { cm }
652
            EditLeft.Text :=
653
             FloatToStrF(PixelTocm(bmpLeft, Tag), ffFixed, 6, 3);
654
            EditTop.Text :=
655
             FloatToStrF(PixelTocm(bmpTop, Tag), ffFixed, 6, 3);
656
            EditWidth.Text :=
657
             FloatToStrF(PixelTocm(bmpWidth, Tag), ffFixed, 6, 3);
658
          end;
659
        3:begin  { inch }
660
            EditLeft.Text :=
661
             FloatToStrF(PixelToInch(bmpLeft, Tag), ffFixed, 6, 3);
662
            EditTop.Text :=
663
             FloatToStrF(PixelToInch(bmpTop, Tag), ffFixed, 6, 3);
664
            EditWidth.Text :=
665
             FloatToStrF(PixelToInch(bmpWidth, Tag), ffFixed, 6, 3);
666
          end;
667
        end;
668
      end;
669
    end;
670
  end
671
  else TagIsZero;  { UnitRG }
672
  EditBorder.Text := IntToStr(BorderWidth);
673
  PaintImage;
674
end;
675

676
function TPrintForm.PixelTomm(const v, t: integer): double;
677
begin
678
  if odd(t)
679
  then Result := 25.4*v/PrinterInfo.yPixPerInch
680
  else Result := 25.4*v/PrinterInfo.xPixPerInch;
681
end;
682

683
function TPrintForm.PixelTocm(const v, t: integer): double;
684
begin
685
  if odd(t)
686
  then Result := 2.54*v/PrinterInfo.yPixPerInch
687
  else Result := 2.54*v/PrinterInfo.xPixPerInch;
688
end;
689

690
function TPrintForm.PixelToInch(const v, t: integer): double;
691
begin
692
  if odd(t)
693
  then Result := v/PrinterInfo.yPixPerInch
694
  else Result := v/PrinterInfo.xPixPerInch;
695
end;
696

697
function TPrintForm.mmToPixel(const v: double; const t: integer): integer;
698
begin
699
  if odd(t)
700
  then Result := round(PrinterInfo.yPixPerInch*v/25.4)
701
  else Result := round(PrinterInfo.xPixPerInch*v/25.4);
702
end;
703

704
function TPrintForm.cmToPixel(const v: double; const t: integer): integer;
705
begin
706
  if odd(t)
707
  then Result := round(PrinterInfo.yPixPerInch*v/2.54)
708
  else Result := round(PrinterInfo.xPixPerInch*v/2.54);
709
end;
710

711
function TPrintForm.InchToPixel(const v: double; const t: integer): integer;
712
begin
713
  if odd(t)
714
  then Result := round(PrinterInfo.yPixPerInch*v)
715
  else Result := round(PrinterInfo.xPixPerInch*v);
716
end;
717

718
procedure TPrintForm.CloseBitBtnClick(Sender: TObject);
719
begin
720
  Close;
721
end;
722

723
end.
724