home *** CD-ROM | disk | FTP | other *** search
/ CD Shareware Magazine 1996 December / CD_shareware_12-96.iso / WIN / Programa / VPE16_14.ZIP / PASCAL / VPEDEMO.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-06-07  |  51.6 KB  |  1,754 lines
  1. {$A+,B-,D-,F-,G+,I-,K+,L-,N-,P-,Q-,R-,S-,T-,V-,W-,X+,Y-}
  2. {$M 8192,8192}
  3.  
  4. {
  5. //              VPEDEMO.PAS
  6. //              ===========
  7. //
  8. // Demonstration of VPE
  9. //
  10. // 12/1995 by IDEAL Software, T. Radde
  11. //}
  12. program VPEDEMO;
  13.  
  14. uses WinTypes,WinProcs,
  15.       {$IFDEF VER80} {Units for Delphi}
  16.        SysUtils,
  17.        Messages,
  18.       {$ELSE}
  19.        Strings,      {Units for BP7}
  20.       {$ENDIF}
  21.       VPEngine;
  22.  
  23.  
  24.  
  25. {----------------------------------------------------------------------------
  26. // Globals:
  27. //----------------------------------------------------------------------------
  28. }
  29.  
  30. {$R VPEDEMO.RES}
  31. var hMainWindow         : HWND;
  32. var hMainDlg            : HWND;
  33.  
  34. const Precision         : LongInt = 0;
  35. const PBackGnd  : LongInt = 0;
  36. const Speed             : LongInt = 0;
  37. const Colors            : LongInt = 0;
  38. const Report            : LongInt = 0;
  39.  
  40.  
  41. var DemoText : array [0..1024] of char;
  42.  
  43. procedure SetDemoText;
  44. begin
  45. StrCat(StrCat(StrCat(StrCat(StrCat(StrCat(StrCat(StrCat(StrCat(StrCat(StrCat(StrCat(StrCat(StrCat(StrCopy(
  46. DemoText,'The moment of impact bursts through the silence and in a roar of sound, the '),
  47. 'final second is prolonged in a world of echoes as if concrete and clay of '),
  48. 'Broadway itself was reliving its memories.'+#13+#10),
  49. 'The last great march past. Newsman stands limp as a whimper as audience and '),
  50. 'eventare locked as one. Bing Crosby coos''You don''t have to feel pain '),
  51. 'to sing the blues, you don''t have to holla - you don''t feel a thing in your '),
  52. 'dollar collar.'' Martin Luther cries ''Everybody Sing!'' and rings the grand old '),
  53. 'liberty bell. Leary, weary of his prison cell, walks on heaven, talks on hell.'+#13+#10),
  54. 'Who needs Medicare and the 35c flat rate fare, when Fred Astaire and '),
  55. 'Ginger Rogers are dancing through the air? From Broadway Melody stereotypes '),
  56. 'the band returns to ''Stars and Stripes'' bringing a tear to the moonshiner, '),
  57. 'who''s been pouring out his spirit from the illegal still. The pawn broker '),
  58. 'clears the noisy till and clutches his lucky dollar bill.'+#13+#10),
  59. 'Then the blackout.'+#13+#10+#13+#10),
  60. '(Genesis, ''The Lamb lies down on Broadway'')'#0);
  61.  
  62. end;
  63.  
  64.  
  65. {//----------------------------------------------------------------------------
  66. //                               Precision
  67. //----------------------------------------------------------------------------
  68. }
  69.  
  70. const HEADLINE = 1;      { ordinal for storing a setting}
  71.  
  72.  
  73. {// Page 1 of Precision demo
  74. // ========================
  75. }
  76. procedure page1(hDoc : LongInt);
  77. var y : Integer;
  78. var WYSIWYG : array[0..512] of char;
  79. begin
  80.    StrCat(StrCat(StrCat(StrCat(StrCat(StrCat(strcopy(WYSIWYG,
  81.    '[Center PenSize 3]This demo shows the capabilities and precision of VPE.'+#13+#10),
  82.    'Print this page and compare not only the '),
  83.    'positions of the frames,'+#13+#10+'but the positions of each letter that can be seen.'+#13+#10),
  84.    '(Switch the grid on.)'+#13+#10),
  85.    'This is true WYSIWYG !!!'+#13+#10+'(''What you see is what you get'')'+#13+#10),
  86.    'Note, that the nearest result can be seen at a scaling of 1:1.'+#13+#10),
  87.    'With every other scaling you get ''best results'' in comparison to execution speed.'#0);
  88.    {y := VpeWriteBox(hdoc, 575, 200, 1625, -1,@WYSIWYG);}
  89.    y := VpeWriteBox(hdoc, 575, 200, 1625, -1,WYSIWYG);
  90.  
  91.  
  92.    y := VpeWriteBox(hdoc, 100, y + 75, 2000, -1,
  93.    '[''Arial'' FontSize 14 Left Bold Italic Underline PenSize 0]'+
  94.    'RIGHT ALIGNED, 0.25 cm blue frame, light-blue backgr., red bold text, Arial 9pt');
  95.    VpeStoreSet(hdoc, HEADLINE);
  96.  
  97.    VpeSelectFont(hdoc, 'Arial', 9);
  98.    VpeSetPen(hdoc, 25, PS_SOLID, COLOR_BLUE);
  99.    VpeSetTextColor(hdoc, COLOR_LTRED);
  100.    VpeSetFontAttr(hdoc, ALIGN_RIGHT, 1, 0, 0);
  101.    VpeSetTransparentMode(hdoc, 0);
  102.    VpeSetBkgColor(hdoc, COLOR_CYAN);
  103.    { y+30 because frame = 0.25cm --> frame drawn around center of coordinates
  104.    // we also want a little gap between the headline and the frame}
  105.    y := VpeWriteBox(hdoc, 150, y + 30, 1850, -1,Demotext);
  106.    VpeSetTransparentMode(hdoc, 1);
  107.  
  108.    VpeUseSet(hdoc, HEADLINE);
  109.    y := VpeWrite(hdoc, 250, y + 75, 2000, -1, 'JUSTIFIED, no frame, Times New Roman 11pt');
  110.  
  111.    VpeSelectFont(hdoc, 'Times New Roman', 11);
  112.    VpeSetFontAttr(hdoc, ALIGN_JUSTIFIED, 0, 0, 0);
  113.    y := VpeWriteBox(hdoc, 250, y + 20, 1550, -1,Demotext);
  114.  
  115.    VpeUseSet(hdoc, HEADLINE);
  116.    y := VpeWriteBox(hdoc, 250, y + 75, 2000, -1, 'CENTERED, thin yellow frame, Times New Roman 11pt');
  117.  
  118.    VpeSelectFont(hdoc, 'Times New Roman', 11);
  119.    VpeSetFontAttr(hdoc, ALIGN_CENTER, 0, 0, 0);
  120.    VpeSetPen(hdoc, 5, PS_SOLID, COLOR_LTYELLOW);
  121.    y := VpeWriteBox(hdoc, 150, y + 20, 1850, -1,Demotext);
  122. end;
  123.  
  124.  
  125. {// Page 2 of Precision demo
  126. // ========================
  127. }
  128. procedure page2(hDoc : LongInt);
  129.  
  130. type PtArray = array[0..3 * 1500] of TPoint;
  131.  
  132. var y : Integer;
  133. var xr,yr,x,xstep : real;
  134. var s : array[0..159] of char;
  135. var index, skip, first, xx, oldy : Integer;
  136. const segments : Integer =0;
  137. var p : LongInt;
  138. var points : ^PtArray;
  139. begin
  140.    VpePageBreak(hdoc);
  141.    VpeUseSet(hdoc, HEADLINE);
  142.    y := VpeWriteBox(hdoc, 200, 200, 2000, -1, 'An example of drawing (better to turn the grid off here):');
  143.    VpeSetPen(hdoc, 8, PS_SOLID, COLOR_BLACK);
  144.    VpeBox(hdoc, 200, 300, 1700, 1800);
  145.    VpeSetPen(hdoc, 3, PS_SOLID, COLOR_BLACK);
  146.  
  147.    xr := 6; xstep := xr / 750;
  148.    yr := 18;
  149.  
  150.    {// The following graph is created with VpeAddPolyPoint()}
  151.    x := -xr;
  152.    skip := 0;
  153.    VpeSetPen(hdoc, 2, PS_SOLID, COLOR_BLUE);
  154.    p := VpePolyLine(hdoc, 0, 1500);
  155.  
  156.    for xx := 200 to 1700-1 do
  157.    begin
  158.       y := Round(1050 - ((x*x*x) - 2*(x*x) - 8*x) / ( yr / 750));
  159.  
  160.       x := x + xstep;
  161.  
  162.       if (y < 300) then
  163.       begin
  164.      y := 300;
  165.      skip := 1;
  166.      continue;
  167.       end
  168.       else if (y > 1800) then
  169.       begin
  170.      y := 1800;
  171.      skip := 1;
  172.      continue;
  173.       end;
  174.  
  175.       if (skip = 1) then
  176.       begin
  177.      VpeAddPolyPoint(hdoc, p, -1, -1);
  178.      oldy := y;
  179.      skip := 2;
  180.       end
  181.       else
  182.       begin
  183.      if (skip = 2) then
  184.      begin
  185.         VpeAddPolyPoint(hdoc, p, xx-1, oldy);
  186.         skip := 0;
  187.      end;
  188.      VpeAddPolyPoint(hdoc, p, xx, y);
  189.      inc(segments);
  190.       end;
  191.    end;
  192.  
  193.  
  194.  
  195.    {// The following graph is created directly with VpePolyLine()}
  196.    New(Points);
  197.    x := -xr;
  198.    first := 1;
  199.    VpeSetPen(hdoc, 2, PS_SOLID, COLOR_LTRED);
  200.    index := 0;
  201.    for xx := 200 to 1700-1 do
  202.    begin
  203.       y := Round(1050 - (3*(x*x) - 4*x - 8) / ( yr / 750));
  204.       x := x+xstep;
  205.  
  206.       if (y < 300) then
  207.       begin
  208.      y := 300;
  209.      skip := 1;
  210.      continue;
  211.       end
  212.       else if (y > 1800) then
  213.       begin
  214.      y := 1800;
  215.      skip := 1;
  216.      continue;
  217.       end;
  218.  
  219.       if (skip = 1) then
  220.       begin
  221.      if (index > 0) then   {// Array must not begin with -1,-1 pair!}
  222.      begin
  223.         points^[index].x := -1;
  224.         points^[index].y := -1;
  225.      end;
  226.      {// don't increment index here, so we don't have multiple
  227.      // (redundant AND FORBIDDEN) -1, -1 pairs in the array}
  228.      oldy := y;
  229.      skip := 2;
  230.       end
  231.       else
  232.       begin
  233.      if (skip = 2) then
  234.      begin
  235.         if (index > 0) then
  236.            inc(index);
  237.         points^[index].x := xx - 1;
  238.         points^[index].y := oldy;
  239.         inc(index);
  240.         skip := 0;
  241.      end;
  242.      points^[index].x := xx;
  243.      points^[index].y := y;
  244.      inc(index);
  245.      inc(segments);
  246.       end;
  247.    end;
  248.  
  249.    VpePolyLine(hdoc, LongInt(points), index);
  250.    Dispose(points);
  251.  
  252.  
  253.  
  254.    {// The following graph is created "manually" VpeLine()
  255.    // Never use it for such tasks, it's slow and memory exhausting
  256.    // in comparision to VpePolyLine()}
  257.    x := -xr;
  258.    first := 1;
  259.    VpeSetPen(hdoc, 2, PS_SOLID, COLOR_GREEN);
  260.    for xx := 200 to 1700-1 do
  261.     begin
  262.       y := Round(1050 - (3*x - 4) / ( yr / 750));
  263.       x :=x+ xstep;
  264.  
  265.       if (y < 300) then
  266.       begin
  267.      y := 300;
  268.      first := 1;
  269.      continue;
  270.       end
  271.       else if (y > 1800) then
  272.       begin
  273.      y := 1800;
  274.      first := 1;
  275.      continue;
  276.       end;
  277.  
  278.       if first <> 0 then
  279.      oldy := y
  280.       else
  281.       begin
  282.      VpeLine(hdoc, xx-1, oldy, xx, y);
  283.      inc(segments);
  284.      oldy := y;
  285.       end;
  286.       first := 0;
  287.    end;
  288.  
  289.  
  290.    VpeSetPen(hdoc, 3, PS_SOLID, COLOR_BLACK);
  291.    VpeLine(hdoc, 200, 1050, 1700, 1050);
  292.    VpeLine(hdoc, 950, 300, 950, 1800);
  293.  
  294.    VpeSelectFont(hdoc, 'Arial', 10);
  295.    VpeSetFontAttr(hdoc, ALIGN_LEFT, 0, 0, 0);
  296.    VpeSetPen(hdoc, 1, PS_DOT, COLOR_BLACK);
  297.    for xx := 1 to Round(xr-1) do
  298.    begin
  299.       VpeLine(hdoc,Round( 950 + xx * 750 / 6), 300,Round(950 + xx * 750 / 6), 1800);
  300.       str(xx,s);
  301.       VpePrint(hdoc,Round(960 + xx * 750 / 6), 1050, s);
  302.       VpeLine(hdoc, Round(950 - xx * 750 / 6), 300,Round(950 - xx * 750 / 6), 1800);
  303.       Str(xx,s);
  304.       VpePrint(hdoc, Round(960 - xx * 750 / 6), 1050, s);
  305.    end;
  306.    y := 2;
  307.    while y < yr do
  308.    begin
  309.       VpeLine(hdoc, 200,Round(1050 + y * 750 / yr), 1700, Round(1050 + y * 750 / yr));
  310.       Str(y,s);
  311.       VpePrint(hdoc, 960,Round(1050 - y * 750 / yr), s);
  312.       VpeLine(hdoc, 200, Round(1050 - y * 750 / yr), 1700,Round(1050 - y * 750 / yr));
  313.       Str(y,s);
  314.       VpePrint(hdoc, 960, Round(1050 + y * 750 / yr), s);
  315.       inc(y,2);
  316.    end;
  317.  
  318.    y := 1850;
  319.    wvsprintf(s, '[S 14]The three graphs together consist of %d (number determined during runtime)'+
  320.                      ' single lines!'+#13+#10+#13+#10+'VPE manages this data bulk for you FAST!', segments);
  321.    VpeWrite(hdoc, 200, y, 2000, -1, s);
  322. end;
  323.  
  324.  
  325.  
  326.  
  327.  
  328.  
  329.  
  330.  
  331.  
  332.  
  333.  
  334. {// Page 3 and 4 of Precision demo
  335. // ==============================}
  336. procedure page3_4(hdoc : LongInt);
  337. var y: integer;
  338. begin
  339.    VpePageBreak(hdoc);
  340.  
  341.    VpeNoPen(hdoc);
  342.    VpeSetFontAttr(hdoc, ALIGN_CENTER, 0, 1, 0);
  343.    VpeSelectFont(hdoc, 'Arial', 18);
  344.    VpeWrite(hdoc, 0, 150, 2100, 300, 'The supported barcode-types:');
  345.    VpeSelectFont(hdoc, 'Arial', 10);
  346.    VpeSetBold(hdoc, 1);
  347.  
  348.    VpeWrite(hdoc, 200, 300, 550, 400, '2 of 5:');
  349.    VpeBarcode(hdoc, 200, 360, 550, 560, BCT_2OF5, '123789', nil);
  350.  
  351.    VpeWrite(hdoc, 700, 300, 1200, 400, 'Interleaved 2 of 5:');
  352.    VpeBarcode(hdoc, 700, 360, 1200, 560, BCT_INTERLEAVED2OF5, '123895783482', nil);
  353.  
  354.    VpeWrite(hdoc, 1350, 300, 1750, 400, 'Code 39 (text on top):');
  355.    VpeSetBarcodeParms(hdoc, 0, 1);
  356.    VpeBarcode(hdoc, 1350, 360, 1750, 560, BCT_CODE39, 'ABC123', nil);
  357.  
  358.    VpeWrite(hdoc, 200, 700, 550, 800, 'Code 93 (rotated):');
  359.    VpeSetBarcodeParms(hdoc, 0, 0);
  360.    VpeSetRotation(hdoc, 900);
  361.    VpeBarcode(hdoc, 275, 760, -300, -200, BCT_CODE93, 'DEF987', nil);
  362.  
  363.    VpeWrite(hdoc, 700, 700, 1200, 800, '[Rot 0]Codabar (rotated):');
  364.    VpeSetRotation(hdoc, 1800);
  365.    VpeBarcode(hdoc, 700, 760, -500, -200, BCT_CODABAR, '123456', nil);
  366.  
  367.    VpeWrite(hdoc, 1400, 700, 1700, 800, '[Rot 0]EAN-8 (rotated):');
  368.    VpeSetRotation(hdoc, 2700);
  369.    VpeBarcode(hdoc, 1450, 760, -300, -200, BCT_EAN8, '40167794', nil);
  370.  
  371.    VpeWrite(hdoc, 200, 1200, 500, 1400, '[Rot 0]EAN-8 + 2:');
  372.    VpeSetBarcodeParms(hdoc, 0, 0);
  373.    VpeBarcode(hdoc, 200, 1260, 500, 1460, BCT_EAN8_2, '12345670', '12');
  374.  
  375.    VpeWrite(hdoc, 700, 1200, 1200, 1400, 'EAN-8 + 5:');
  376.    VpeSetBarcodeParms(hdoc, 0, 0);
  377.    VpeBarcode(hdoc, 700, 1260, 1200, 1460, BCT_EAN8_5, '98765430', '12345');
  378.  
  379.    VpeWrite(hdoc, 1350, 1200, 1750, 1400, 'EAN-13:');
  380.    VpeBarcode(hdoc, 1350, 1260, 1750, 1460, BCT_EAN13, '9781556153952', nil);
  381.  
  382.    VpeWrite(hdoc, 200, 1600, 600, 1800, 'EAN-13 + 2:');
  383.    VpeBarcode(hdoc, 200, 1660, 600, 1860, BCT_EAN13_2, '4501645096787', '12');
  384.  
  385.    VpeWrite(hdoc, 700, 1600, 1200, 1800, 'EAN-13 + 5:');
  386.    VpeSetBarcodeParms(hdoc, 0, 0);
  387.    VpeBarcode(hdoc, 700, 1660, 1200, 1860, BCT_EAN13_5, '9781556153952', '12345');
  388.  
  389.    VpeWrite(hdoc, 1350, 1600, 1750, 1800, 'EAN-128 A:');
  390.    VpeSetBarcodeParms(hdoc, 0, 0);
  391.    VpeBarcode(hdoc, 1350, 1660, 1750, 1860, BCT_EAN128A, 'EAN-128 A', nil);
  392.  
  393.    VpeWrite(hdoc, 200, 2000, 600, 2200, 'EAN-128 B:');
  394.    VpeBarcode(hdoc, 200, 2060, 600, 2260, BCT_EAN128B, 'ean-128 b', nil);
  395.  
  396.    VpeWrite(hdoc, 700, 2000, 1200, 2200, 'EAN-128 C:');
  397.    VpeBarcode(hdoc, 700, 2060, 1200, 2260, BCT_EAN128C, '128902', nil);
  398.  
  399.    VpeWrite(hdoc, 1350, 2000, 1850, 2200, 'POSTNET (1.20) 5 or 9 digits:');
  400.    VpeBarcode(hdoc, 1350, 2060, 1628, 2120, BCT_POSTNET, '12345', nil);
  401.    VpeBarcode(hdoc, 1350, 2150, 1850, 2210, BCT_POSTNET, '414649623', nil);
  402.  
  403.    VpePageBreak(hdoc);
  404.  
  405.    VpeSetFontAttr(hdoc, ALIGN_CENTER, 0, 1, 0);
  406.    VpeSelectFont(hdoc, 'Arial', 18);
  407.    VpeWrite(hdoc, 0, 150, 2100, 300, 'The supported barcode-types (continued):');
  408.    VpeSelectFont(hdoc, 'Arial', 10);
  409.    VpeSetBold(hdoc, 1);
  410.  
  411.    VpeWrite(hdoc, 200, 300, 550, 400, 'UPC-A:');
  412.    VpeBarcode(hdoc, 200, 360, 550, 560, BCT_UPCA, '07447079382', nil);
  413.  
  414.    VpeWrite(hdoc, 700, 300, 1100, 400, 'UPC-A + 2:');
  415.    VpeBarcode(hdoc, 700, 360, 1100, 560, BCT_UPCA_2, '07447079382', '01');
  416.  
  417.    VpeWrite(hdoc, 1350, 300, 1800, 400, 'UPC-A + 5:');
  418.    VpeBarcode(hdoc, 1350, 360, 1800, 560, BCT_UPCA_5, '03126764825', '94687');
  419.  
  420.    VpeWrite(hdoc, 200, 700, 550, 900, 'UPC-E:');
  421.    VpeBarcode(hdoc, 200, 760, 550, 960, BCT_UPCE, '0378492', nil);
  422.  
  423.    VpeWrite(hdoc, 700, 700, 1100, 900, 'UPC-E + 2:');
  424.    VpeBarcode(hdoc, 700, 760, 1100, 960, BCT_UPCE_2, '0378492', '14');
  425.  
  426.    VpeWrite(hdoc, 1350, 700, 1800, 900, 'UPC-E + 5:');
  427.    VpeBarcode(hdoc, 1350, 760, 1800, 960, BCT_UPCE_5, '0364825', '79462');
  428.  
  429.    VpeSetFontAttr(hdoc, ALIGN_LEFT, 0, 0, 0);
  430.    y:= VpeWrite(hdoc, 200, 1100, 1800, VFREE,
  431.       'VPE supports 21 barcode types. Barcodes can be rotated in 90 degree steps, the '+
  432.       'text can be drawn on bottom or top of the barcode, and also independently '+
  433.       'the add-on text. Any of these features can be combined.');
  434.  
  435.    y := VpePrint(hdoc, 500, y+100, '[S 24 U C LtYellow]Text and images');
  436.    VpePrint(hdoc, VRIGHT, VBOTTOM, '[Rot 900 C Blue] can be freely ');
  437.    VpeWriteBox(hdoc, 500, VBOTTOM, VLEFT, VFREE, '[Rot 1800 C Red CE]rotated in 90');
  438.  
  439.    { The WIDTH (after rotation it's the height) is the top of the last inserted text
  440.      minus the bottom of the first inserted object.}
  441.    VpeWriteBox(hdoc, 400, y, -(VpeGet(hdoc, VTOP) - y), VFREE, '[Rot 2700 C Green]degree steps');
  442. end;
  443.  
  444.  
  445. { Page 5 of Precision demo
  446.   ======================== }
  447. procedure page5(hdoc : LongInt);
  448. var x, y, y2 : Integer;
  449.     p : LongInt;
  450. begin
  451.  
  452.    VpePageBreak(hdoc);
  453.    VpeUseSet(hdoc, HEADLINE);
  454.    y := VpeWriteBox(hdoc, 100, 200, 2000, -1,
  455.            'VPE is also able to manage bitmaps for you!'+#13+#10+
  456.            'Place your logo wherever you want.');
  457.    y := VpeWriteBox(hdoc, 100, y, 1400, -1,
  458.        '[S 10 L BO IO UO](Note: These are 256-color bitmaps, in 16-color mode it doesn''t look very good)');
  459.  
  460.    y := VpeWriteBox(hdoc, 100, y + 50, 1400, -1, '[N B U]VPE supports the following graphics file formats:');
  461.        VpeWriteBox(hdoc, 100, y, 1400, -1,
  462.        '-Windows and OS/2 Bitmaps (2 / 16 / 256 / True Color)'+#13+#10+
  463.        '-Windows WMF (Metafile)'+#13+#10+
  464.        '-AutoCAD DXF'+#13+#10+
  465.        '-GIF (2 / 16 / 256 Colors)'+#13+#10+
  466.        '-PCX (2 / 16 / 256 Colors)'+#13+#10+
  467.        '-JPG (256 / True Color)'+#13+#10+
  468.        '-TIFF 5.0 (2 / 16 / 256 / True Color, LZW / PackBits / Fax G3 & G4 / Tiled Images)'+#13+#10+
  469.        '-Microsoft filters (feature, some restrictions and only 16-bit version)');
  470.    VpeSetPen(hdoc, 5, PS_SOLID, COLOR_BLACK);
  471.    VpePicture(hdoc, 1400, 150, -1, -1, 'logo.bmp', PIC_KEEPIMAGE or PIC_KEEP_DIB_PAGE);
  472.    y := VpeGet(hdoc, VBOTTOM);
  473.    x := VpeGet(hdoc, VRIGHT);
  474.    VpeWriteBox(hdoc, 1400, y, x, -1, '[N S 14 CE C White BC Red TO Italic Bold]IDEAL Software');
  475.    VpeDefaultBitmapDPI(hdoc, 96, 96);
  476.    VpePicture(hdoc, 1400, VpeGet(hdoc, VBOTTOM) + 100, -1, -1, 'fruits.bmp', PIC_KEEPIMAGE or PIC_KEEP_DIB_PAGE);
  477.  
  478.    y := VpeWriteBox(hdoc, 150, y + 400, 1500, -1,
  479.            '[S 14 CE PS 0]Scale your bitmaps as you like:');
  480.    inc(y,20);
  481.    VpeSetPen(hdoc, 3, PS_SOLID, COLOR_BLACK);
  482.    VpePicture(hdoc, 150, y, 200, -1, 'logo.bmp', PIC_KEEPIMAGE or PIC_KEEP_DIB_PAGE);
  483.    VpePicture(hdoc, VpeGet(hdoc, VRIGHT) + 100, y, VpeGet(hdoc, VRIGHT) + 250, -1, 'logo.bmp',
  484.                   PIC_KEEPIMAGE or PIC_KEEP_DIB_PAGE);
  485.    VpePicture(hdoc, VpeGet(hdoc, VRIGHT) + 100, y, VpeGet(hdoc, VRIGHT) + 750, -1, 'logo.bmp',
  486.                  PIC_KEEPIMAGE or PIC_KEEP_DIB_PAGE);
  487.  
  488.    y := VpeGet(hdoc, VBOTTOM) + 300;
  489.    y := VpePrint(hdoc, 150, y, '[N U]Draw! Set the Pen, Background Color and Hatch Style:');
  490.    y := y+50;
  491.    VpeSetTransparentMode(hdoc, 0);
  492.    VpeSetBkgColor(hdoc, COLOR_BLUE);
  493.    VpeBox(hdoc, 150, y, -300, -300);
  494.  
  495.    VpeSetHatchStyle(hdoc, HS_BDIAGONAL);
  496.    VpeSetHatchColor(hdoc, COLOR_BLUE);
  497.    VpeSetBkgColor(hdoc, COLOR_LTYELLOW);
  498.    VpeNoPen(hdoc);
  499.    p := VpePolygon(hdoc, 0, 4);
  500.    VpeAddPolygonPoint(hdoc, p, 250, y+400);
  501.    VpeAddPolygonPoint(hdoc, p, 500, y+600);
  502.    VpeAddPolygonPoint(hdoc, p, 300, y+700);
  503.    VpeAddPolygonPoint(hdoc, p, 150, y+1000);
  504.  
  505.    VpeSetPen(hdoc, 6, PS_SOLID, COLOR_BLACK);
  506.    p := VpePolygon(hdoc, 0, 4);
  507.    VpeAddPolygonPoint(hdoc, p, 650, y);
  508.    VpeAddPolygonPoint(hdoc, p, 1000, y+200);
  509.    VpeAddPolygonPoint(hdoc, p, 700, y+300);
  510.    VpeAddPolygonPoint(hdoc, p, 550, y+600);
  511.  
  512.    VpeNoPen(hdoc);
  513.    VpeSetHatchStyle(hdoc, HS_DIAGCROSS);
  514.    VpeSetHatchColor(hdoc, COLOR_RED);
  515.    VpeSetBkgColor(hdoc, COLOR_CYAN);
  516.    VpeEllipse(hdoc, 750, 2150, -500, -300);
  517.  
  518.    VpeSetHatchStyle(hdoc, HS_FDIAGONAL);
  519.    VpeSetPen(hdoc, 10, PS_SOLID, COLOR_GREEN);
  520.    VpeSetTransparentMode(hdoc, 1);
  521.    y2 := VpeWrite(hdoc, 1200, y + 200, -500, -1, '[S 12 B CE]Write text beyond,');
  522.    VpeEllipse(hdoc, 1200, y, -500, -500);
  523.    VpeWrite(hdoc, 1200, y2, -500, -1, 'or above the hatching.');
  524.  
  525.    VpeSetTransparentMode(hdoc, 0);
  526.    VpeWriteBox(hdoc, 770, 2280, -460, -1, '[PS 3 PC Black HSN BC Cyan S 10 NB]Or blank the hatching out.');
  527.  
  528.    VpeSetTransparentMode(hdoc, 1);
  529. end;
  530.  
  531.  
  532. { Page 6 of Precision demo
  533.   ======================== }
  534. procedure page6(hdoc : LongInt);
  535. begin
  536.    VpePageBreak(hdoc);
  537.  
  538.    VpeNoPen(hdoc);
  539.    VpePicture(hdoc, 0, 0, -1, -1, 'gew.tif', PIC_KEEPIMAGE or PIC_KEEP_DIB_PAGE);
  540.  
  541.    VpeWrite(hdoc, 250, 130, 1200, -1, '[S 24 C LtRed L PS 0]Stadt Xhausen');
  542.    VpeWrite(hdoc, 250, 500, 1000, -1, '[S 14 C Blue]Mustermann & Co.'+#13+#10+'Feinkost Im- und Export');
  543.    VpeWrite(hdoc, 1200, 460, 1700, -1, '[S 11 B]Dⁿsseldorf');
  544.    VpeWrite(hdoc, 250, 680, 750, -1, 'Schmidt');
  545.    VpeWrite(hdoc, 250, 840, 750, -1, '24.7. 1947');
  546.    VpeWrite(hdoc, 500, 840, 1000, -1, 'Oberammergau');
  547.    VpeWrite(hdoc, 250, 1010, 750, -1, 'Zunderstr. 93');
  548.    VpeWrite(hdoc, 1000, 1010, 1750, -1, '0 27 84 / 16 45 98');
  549.    VpeWrite(hdoc, 250, 1265, 1750, -1, 'Willi-Graf-Str. 17');
  550.    VpeWrite(hdoc, 1000, 1265, 1750, -1, '0 27 84 / 23 54 90');
  551.    VpeWrite(hdoc, 1220, 670, 1750, -1, 'Heinz - Willi');
  552.    VpeWrite(hdoc, 1100, 1400, 1950, -1,
  553.    '[S 10 J I]'+
  554.    'It is very important to mention here, that there is no problem in using '+
  555.    'the special features of VPE, like justified text and all the other attributes. '+
  556.    'Here you can see justified italic text. These features and options make VPE'+
  557.    ' a professional tool, that makes document processing easy for the '+
  558.    'developer, as well as for the end-user.');
  559. end;
  560.  
  561. { Precision demo
  562.   ============== }
  563. procedure precisiondemo(mode : Integer);
  564. var hDoc : LongInt;
  565. begin
  566.  
  567.    if (mode = 0) then
  568.    begin
  569.       hdoc := VpeOpenDoc(hMainWindow, 'Precision + Capabilities', -1, -1, VPE_EMBEDDED or VPE_GRID_POSSIBLE or VPE_ROUTE_HELP);
  570.       Precision := hdoc;
  571.    end
  572.    else
  573.    begin
  574.       hdoc := VpeOpenDoc(hMainWindow, 'Precision + Capabilities',  -1, -1, 0);
  575.       PBackGnd := hdoc;
  576.    end;
  577.  
  578.    VpeSetAutoBreak(hdoc, AUTO_BREAK_NO_LIMITS);
  579.    VpeSetFontAttr(hdoc, ALIGN_LEFT, 0, 1, 1);
  580.    VpeSetPen(hdoc, 0, PS_SOLID, 0);
  581.    VpeDefineHeader(hdoc, 100, 100, 1000, 150, 'Precision + Capabilities   /  IDEAL Software');
  582.    VpeSetUnderlined(hdoc, 0);
  583.    VpeDefineFooter(hdoc, 1900, 2800, 2100, 2900, 'Page @PAGE');
  584.  
  585.    page1(hdoc);
  586.    page2(hdoc);
  587.    page3_4(hdoc);
  588.    page5(hdoc);
  589.    page6(hdoc);
  590.  
  591.    VpeRemoveSet(hdoc, HEADLINE);
  592.    VpeGotoPage(hdoc, 1);
  593.  
  594.    if (mode = 0) then
  595.       VpePreviewDoc(hdoc, nil, VPE_SHOW_NORMAL)
  596.    else
  597.       VpePrintDoc(hdoc, 0);
  598. end;
  599.  
  600. { ----------------------------------------------------------------------------
  601.   Report Demo
  602.  
  603.   This all is done manually, only for your eyes...
  604.   ---------------------------------------------------------------------------- }
  605. procedure reporttest;
  606. var hDoc : LongInt;
  607. var y : Integer;
  608. begin
  609.  
  610.    hdoc := VpeOpenDoc(hMainWindow, 'Report', -1, -1, 0);
  611.    Report := hdoc;
  612.    VpeSetAutoBreak(hdoc, AUTO_BREAK_NO_LIMITS);
  613.    VpeSetPen(hdoc, 5, PS_SOLID, COLOR_BLACK);
  614.    VpeDefaultBitmapDPI(hdoc, 96, 96);
  615.    VpePicture(hdoc, 1650, 150, -1, -1, 'fruits.bmp', PIC_KEEPIMAGE or PIC_KEEP_DIB_PAGE);
  616.    VpeWriteBox(hdoc, 1650, VpeGet(hdoc, VBOTTOM), VpeGet(hdoc, VRIGHT), -1,
  617.        '[N S 9 CE I C Blue BC Gray TO]Fruits of Doom Software');
  618.    y := VpeGet(hdoc, VBOTTOM) + 100;
  619.    VpePrint(hdoc, 150, 200, '[N S 26 U]Year End Results');
  620.    VpePrint(hdoc, 150, 400, '[N S 32]Fruits of Doom Software');
  621.  
  622.    VpeLine(hdoc, 150, y, 2000, y);
  623.    inc(y,50);
  624.  
  625.    VpeNoPen(hdoc);
  626.    VpePrintBox(hdoc, 150, y, '[N S 18 C Blue]Product: Apples');
  627.    y := VpeGet(hdoc, VBOTTOM) + 10;
  628.    VpePrint(hdoc, 150, y, '[S 16 C Purple]Country');
  629.    VpePrint(hdoc, 650, y, 'Quantity');
  630.    VpePrint(hdoc, 1150, y, 'Value (in $)');
  631.  
  632.    y := VpeGet(hdoc, VBOTTOM);
  633.    VpeSetTransparentMode(hdoc, 0);
  634.    VpeSetBkgColor(hdoc, COLOR_GRAY);
  635.    VpeBox(hdoc, 150, y, 1550, y+60);
  636.    VpeSetTransparentMode(hdoc, 1);
  637.    VpePrint(hdoc, 150, y, '[S 14 C Black]Germany');
  638.    VpeWrite(hdoc, 650, y, 900, y+60, '[R]2.450,00');
  639.    VpeWrite(hdoc, 1150, y, 1450, y+60, '120.050,00');
  640.  
  641.    y := VpeGet(hdoc, VBOTTOM);
  642.    VpeSetTransparentMode(hdoc, 0);
  643.    VpeSetBkgColor(hdoc, COLOR_CYAN);
  644.    VpeBox(hdoc, 150, y, 1550, y+60);
  645.    VpeSetTransparentMode(hdoc, 1);
  646.    VpePrint(hdoc, 150, y, 'Great Britain');
  647.    VpeWrite(hdoc, 650, y, 900, y+60, '2.250,00');
  648.    VpeWrite(hdoc, 1150, y, 1450, y+60, '110.250,00');
  649.  
  650.    y := VpeGet(hdoc, VBOTTOM);
  651.    VpeSetTransparentMode(hdoc, 0);
  652.    VpeSetBkgColor(hdoc, COLOR_GRAY);
  653.    VpeBox(hdoc, 150, y, 1550, y+60);
  654.    VpeSetTransparentMode(hdoc, 1);
  655.    VpePrint(hdoc, 150, y, 'France');
  656.    VpeWrite(hdoc, 650, y, 900, y+60, '1.700,00');
  657.    VpeWrite(hdoc, 1150, y, 1450, y+60, '83.300,00');
  658.  
  659.    y := VpeGet(hdoc, VBOTTOM);
  660.    VpeSetTransparentMode(hdoc, 0);
  661.    VpeSetBkgColor(hdoc, COLOR_CYAN);
  662.    VpeBox(hdoc, 150, y, 1550, y+60);
  663.    VpeSetTransparentMode(hdoc, 1);
  664.    VpePrint(hdoc, 150, y, 'USA');
  665.    VpeWrite(hdoc, 650, y, 900, y+60, '3.200,00');
  666.    VpeWrite(hdoc, 1150, y, 1450, y+60, '156.800,00');
  667.  
  668.    y := VpeGet(hdoc, VBOTTOM);
  669.    VpeSetTransparentMode(hdoc, 0);
  670.    VpeSetBkgColor(hdoc, COLOR_GRAY);
  671.    VpeBox(hdoc, 150, y, 1550, y+60);
  672.    VpeSetTransparentMode(hdoc, 1);
  673.    VpePrint(hdoc, 150, y, 'Australia');
  674.    VpeWrite(hdoc, 650, y, 900, y+60, '1.080,00');
  675.    VpeWrite(hdoc, 1150, y, 1450, y+60, '52.920,00');
  676.  
  677.    y := VpeGet(hdoc, VBOTTOM);
  678.    VpePrint(hdoc, 150, y, 'Total');
  679.    VpeWrite(hdoc, 650, y, 900, y+60, '10.680,00');
  680.    VpeWrite(hdoc, 1150, y, 1450, y+60, '523.320,00');
  681.  
  682.  
  683.  
  684.  
  685.    inc(y,210);
  686.    VpePrintBox(hdoc, 150, y, '[N S 18 C Blue]Product: Oranges');
  687.    y := VpeGet(hdoc, VBOTTOM) + 10;
  688.    VpePrint(hdoc, 150, y, '[S 16 C Purple]Country');
  689.    VpePrint(hdoc, 650, y, 'Quantity');
  690.    VpePrint(hdoc, 1150, y, 'Value (in $)');
  691.  
  692.    y := VpeGet(hdoc, VBOTTOM);
  693.    VpeSetTransparentMode(hdoc, 0);
  694.    VpeSetBkgColor(hdoc, COLOR_GRAY);
  695.    VpeBox(hdoc, 150, y, 1550, y+60);
  696.    VpeSetTransparentMode(hdoc, 1);
  697.    VpePrint(hdoc, 150, y, '[S 14 C Black]Germany');
  698.    VpeWrite(hdoc, 650, y, 900, y+60, '[R]2.450,00');
  699.    VpeWrite(hdoc, 1150, y, 1450, y+60, '120.050,00');
  700.  
  701.    y := VpeGet(hdoc, VBOTTOM);
  702.    VpeSetTransparentMode(hdoc, 0);
  703.    VpeSetBkgColor(hdoc, COLOR_CYAN);
  704.    VpeBox(hdoc, 150, y, 1550, y+60);
  705.    VpeSetTransparentMode(hdoc, 1);
  706.    VpePrint(hdoc, 150, y, 'Great Britain');
  707.    VpeWrite(hdoc, 650, y, 900, y+60, '2.250,00');
  708.    VpeWrite(hdoc, 1150, y, 1450, y+60, '110.250,00');
  709.  
  710.    y := VpeGet(hdoc, VBOTTOM);
  711.    VpeSetTransparentMode(hdoc, 0);
  712.    VpeSetBkgColor(hdoc, COLOR_GRAY);
  713.    VpeBox(hdoc, 150, y, 1550, y+60);
  714.    VpeSetTransparentMode(hdoc, 1);
  715.    VpePrint(hdoc, 150, y, 'France');
  716.    VpeWrite(hdoc, 650, y, 900, y+60, '1.700,00');
  717.    VpeWrite(hdoc, 1150, y, 1450, y+60, '83.300,00');
  718.  
  719.    y := VpeGet(hdoc, VBOTTOM);
  720.    VpeSetTransparentMode(hdoc, 0);
  721.    VpeSetBkgColor(hdoc, COLOR_CYAN);
  722.    VpeBox(hdoc, 150, y, 1550, y+60);
  723.    VpeSetTransparentMode(hdoc, 1);
  724.    VpePrint(hdoc, 150, y, 'USA');
  725.    VpeWrite(hdoc, 650, y, 900, y+60, '3.200,00');
  726.    VpeWrite(hdoc, 1150, y, 1450, y+60, '156.800,00');
  727.  
  728.    y := VpeGet(hdoc, VBOTTOM);
  729.    VpeSetTransparentMode(hdoc, 0);
  730.    VpeSetBkgColor(hdoc, COLOR_GRAY);
  731.    VpeBox(hdoc, 150, y, 1550, y+60);
  732.    VpeSetTransparentMode(hdoc, 1);
  733.    VpePrint(hdoc, 150, y, 'Australia');
  734.    VpeWrite(hdoc, 650, y, 900, y+60, '1.080,00');
  735.    VpeWrite(hdoc, 1150, y, 1450, y+60, '52.920,00');
  736.  
  737.    y := VpeGet(hdoc, VBOTTOM);
  738.    VpePrint(hdoc, 150, y, 'Total');
  739.    VpeWrite(hdoc, 650, y, 900, y+60, '10.680,00');
  740.    VpeWrite(hdoc, 1150, y, 1450, y+60, '523.320,00');
  741.  
  742.    inc(y, 210);
  743.    VpePrintBox(hdoc, 150, y, '[N S 18 C Blue]Product: Bananas');
  744.    y := VpeGet(hdoc, VBOTTOM) + 10;
  745.    VpePrint(hdoc, 150, y, '[S 16 C Purple]Country');
  746.    VpePrint(hdoc, 650, y, 'Quantity');
  747.    VpePrint(hdoc, 1150, y, 'Value (in $)');
  748.  
  749.    y := VpeGet(hdoc, VBOTTOM);
  750.    VpeSetTransparentMode(hdoc, 0);
  751.    VpeSetBkgColor(hdoc, COLOR_GRAY);
  752.    VpeBox(hdoc, 150, y, 1550, y+60);
  753.    VpeSetTransparentMode(hdoc, 1);
  754.    VpePrint(hdoc, 150, y, '[S 14 C Black]Germany');
  755.    VpeWrite(hdoc, 650, y, 900, y+60, '[R]2.450,00');
  756.    VpeWrite(hdoc, 1150, y, 1450, y+60, '120.050,00');
  757.  
  758.    y := VpeGet(hdoc, VBOTTOM);
  759.    VpeSetTransparentMode(hdoc, 0);
  760.    VpeSetBkgColor(hdoc, COLOR_CYAN);
  761.    VpeBox(hdoc, 150, y, 1550, y+60);
  762.    VpeSetTransparentMode(hdoc, 1);
  763.    VpePrint(hdoc, 150, y, 'Great Britain');
  764.    VpeWrite(hdoc, 650, y, 900, y+60, '2.250,00');
  765.    VpeWrite(hdoc, 1150, y, 1450, y+60, '110.250,00');
  766.  
  767.    y := VpeGet(hdoc, VBOTTOM);
  768.    VpeSetTransparentMode(hdoc, 0);
  769.    VpeSetBkgColor(hdoc, COLOR_GRAY);
  770.    VpeBox(hdoc, 150, y, 1550, y+60);
  771.    VpeSetTransparentMode(hdoc, 1);
  772.    VpePrint(hdoc, 150, y, 'France');
  773.    VpeWrite(hdoc, 650, y, 900, y+60, '1.700,00');
  774.    VpeWrite(hdoc, 1150, y, 1450, y+60, '83.300,00');
  775.  
  776.    y := VpeGet(hdoc, VBOTTOM);
  777.    VpeSetTransparentMode(hdoc, 0);
  778.    VpeSetBkgColor(hdoc, COLOR_CYAN);
  779.    VpeBox(hdoc, 150, y, 1550, y+60);
  780.    VpeSetTransparentMode(hdoc, 1);
  781.    VpePrint(hdoc, 150, y, 'USA');
  782.    VpeWrite(hdoc, 650, y, 900, y+60, '3.200,00');
  783.    VpeWrite(hdoc, 1150, y, 1450, y+60, '156.800,00');
  784.  
  785.    y := VpeGet(hdoc, VBOTTOM);
  786.    VpeSetTransparentMode(hdoc, 0);
  787.    VpeSetBkgColor(hdoc, COLOR_GRAY);
  788.    VpeBox(hdoc, 150, y, 1550, y+60);
  789.    VpeSetTransparentMode(hdoc, 1);
  790.    VpePrint(hdoc, 150, y, 'Australia');
  791.    VpeWrite(hdoc, 650, y, 900, y+60, '1.080,00');
  792.    VpeWrite(hdoc, 1150, y, 1450, y+60, '52.920,00');
  793.  
  794.    y := VpeGet(hdoc, VBOTTOM);
  795.    VpePrint(hdoc, 150, y, 'Total');
  796.    VpeWrite(hdoc, 650, y, 900, y+60, '10.680,00');
  797.    VpeWrite(hdoc, 1150, y, 1450, y+60, '523.320,00');
  798.  
  799.    y := VpeGet(hdoc, VBOTTOM) + 210;
  800.    VpePrint(hdoc, 150, y, '[S 20 U]Yearly Country Sales Total: $1.569.960,00');
  801.  
  802.   { Draw a pie
  803.     use the VpeGet()-stuff to easily position this anywhere on the paper
  804.     ====================================================================}
  805.   VpePageBreak(hdoc);
  806.   VpeSelectFont(hdoc, 'Times New Roman', 12);
  807.   VpePrint(hdoc, 200, VBOTTOM, '[N S 18 U]Analyze of Paradise:');
  808.   VpeSetPen(hdoc, 3, PS_SOLID, COLOR_BLACK);
  809.   VpeSetTransparentMode(hdoc, 0);
  810.   VpeSetBkgColor(hdoc, COLOR_RED);
  811.  
  812.   VpePie(hdoc, 200, VpeGet(hdoc, VBOTTOM) + 100, -600, -600, 0, 300);
  813.   VpeStorePos(hdoc);
  814.   VpeBox(hdoc, VpeGet(hdoc, VRIGHT) + 200, VpeGet(hdoc, VTOP) + 20, -30, -30);
  815.   VpePrint(hdoc, VpeGet(hdoc, VRIGHT) + 30, VpeGet(hdoc, VTOP) - 10, '[N T]Apples');
  816.  
  817.   VpeRestorePos(hdoc);
  818.   VpeSetBkgColor(hdoc, COLOR_BLUE);
  819.   VpePie(hdoc, VLEFT, VTOP, VRIGHT, VBOTTOM, 300, 750);
  820.   VpeStorePos(hdoc);
  821.   VpeBox(hdoc, VpeGet(hdoc, VRIGHT) + 200, VpeGet(hdoc, VTOP) + 70, -30, -30);
  822.   VpePrint(hdoc, VpeGet(hdoc, VRIGHT) + 30, VpeGet(hdoc, VTOP) - 10, '[N T]Oranges');
  823.  
  824.   VpeRestorePos(hdoc);
  825.   VpeSetBkgColor(hdoc, COLOR_LTYELLOW);
  826.   VpePie(hdoc, VLEFT, VTOP, VRIGHT, VBOTTOM, 750, 1500);
  827.   VpeStorePos(hdoc);
  828.   VpeBox(hdoc, VpeGet(hdoc, VRIGHT) + 200, VpeGet(hdoc, VTOP) + 120, -30, -30);
  829.   VpePrint(hdoc, VpeGet(hdoc, VRIGHT) + 30, VpeGet(hdoc, VTOP) - 10, '[N T]Bananas');
  830.  
  831.   VpeRestorePos(hdoc);
  832.   VpeSetBkgColor(hdoc, COLOR_GREEN);
  833.   VpePie(hdoc, VLEFT, VTOP, VRIGHT, VBOTTOM, 1500, 2900);
  834.   VpeStorePos(hdoc);
  835.   VpeBox(hdoc, VpeGet(hdoc, VRIGHT) + 200, VpeGet(hdoc, VTOP) + 170, -30, -30);
  836.   VpePrint(hdoc, VpeGet(hdoc, VRIGHT) + 30, VpeGet(hdoc, VTOP) - 10, '[N T]Cherries');
  837.  
  838.   VpeRestorePos(hdoc);
  839.   VpeSetBkgColor(hdoc, COLOR_CYAN);
  840.   VpePie(hdoc, VLEFT, VTOP, VRIGHT, VBOTTOM, 2900, 0);
  841.   VpeStorePos(hdoc);
  842.   VpeBox(hdoc, VpeGet(hdoc, VRIGHT) + 200, VpeGet(hdoc, VTOP) + 220, -30, -30);
  843.   VpePrint(hdoc, VpeGet(hdoc, VRIGHT) + 30, VpeGet(hdoc, VTOP) - 10, '[N T]Coconuts');
  844.  
  845.   VpeSetTransparentMode(hdoc, 1);
  846.  
  847.   VpeGotoPage(hdoc, 1);
  848.  
  849.   VpePreviewDoc(hdoc, nil, VPE_SHOW_NORMAL);
  850. end;
  851.  
  852.  
  853.  
  854. { ----------------------------------------------------------------------------
  855.                 Colortest
  856.   ---------------------------------------------------------------------------- }
  857. procedure colortest;
  858.  
  859. const range  = 1400;
  860. const step   = 1;
  861. const color_step = 2;
  862. const min_color = 0;
  863. const max_color = 255;
  864.  
  865. var  hdoc : LongInt;
  866. var  rc  : TRect;
  867. var  x, y : Integer;
  868. var  r, g, b : Integer;
  869. var  delta_r, delta_g, delta_b : Integer;
  870. var  xx, factor : real;
  871.  
  872. begin
  873.    hdoc := VpeOpenDoc(hMainWindow, 'Colors', -1, -1, VPE_NO_MOUSE_SCALE or VPE_NO_USER_MOVE
  874.       or VPE_NO_USER_CLOSE or VPE_NO_STATBAR or VPE_NO_RULER or VPE_NO_HELPBTN or VPE_NO_INFOBTN);
  875.    VpeSetScale(hdoc, 0.25);
  876.    Colors := hdoc;
  877.  
  878.    VpeSetAutoBreak(hdoc, AUTO_BREAK_NO_LIMITS);
  879.    VpeSetPen(hdoc, 0, PS_SOLID, COLOR_BLACK);
  880.    VpeSelectFont(hdoc, 'Arial', 30);
  881.  
  882.    xx := -3.1415;
  883.    factor := 2 * abs(xx) / range * step;
  884.  
  885.    r := 192;
  886.    delta_r := color_step;
  887.    g := min_color+1;
  888.    delta_g := color_step;
  889.    b := min_color+1;
  890.    delta_b := color_step;
  891.  
  892.    x := 100;
  893.    while x < range+100 do
  894.    begin
  895.      y := Round(sin(xx) * 500.0 + 500);
  896.      VpeSetTextColor(hdoc, RGB( r, g, b));
  897.      VpeWriteBox(hdoc, x, y, x+800, y + 120, 'Color Test');
  898.  
  899.      if (x mod 10 = 0) then
  900.      begin
  901.     xx :=xx+ factor;
  902.     inc(x,step);
  903.     y  := Round(sin(xx) * 500.0 + 500);
  904.     VpeSetTextColor(hdoc, COLOR_BLACK);
  905.     VpeWriteBox(hdoc, x, y, x+800, y + 120, 'Color Test');
  906.      end;
  907.  
  908.      xx :=xx+ factor;
  909.      if (r > min_color) and (r < max_color) then
  910.      begin
  911.     inc(r,delta_r);
  912.     if (r < min_color) then
  913.        r := min_color;
  914.     if (r > max_color) then
  915.        r := max_color;
  916.      end
  917.      else if (g > min_color) and (g < max_color) then
  918.      begin
  919.     inc(g, delta_g);
  920.     if (g < min_color) then
  921.        g := min_color;
  922.     if (g > max_color) then
  923.        g := max_color;
  924.      end
  925.      else if (b > min_color) and (b < max_color) then
  926.      begin
  927.     inc(b,delta_b);
  928.     if (b < min_color) then
  929.        b := min_color;
  930.     if (b > max_color) then
  931.        b := max_color;
  932.      end;
  933.  
  934.      if (r >= max_color) and (b >= max_color) then
  935.      begin
  936.     delta_r := -color_step;
  937.     r := max_color-1;
  938.      end;
  939.      if (r >= min_color) and (g >= max_color) then
  940.      begin
  941.     delta_g := -color_step;
  942.     g := max_color-1;
  943.      end;
  944.      if (g = min_color) and (b >= max_color) then
  945.      begin
  946.     delta_b := -color_step;
  947.     b := max_color-1;
  948.      end;
  949.  
  950.      if (r=min_color) and (g=min_color) and (b=min_color) then
  951.      begin
  952.     r := min_color+1; g:=min_color+1; b:=min_color+1;
  953.     delta_b := color_step;
  954.     delta_g := color_step;
  955.     delta_r := color_step;
  956.      end;
  957.      inc(x,step);
  958.    end;
  959.  
  960.    rc.left := 0;
  961.    rc.top  := 0;
  962.    rc.right := 280;
  963.    rc.bottom :=200;
  964.    VpePreviewDoc(hdoc, @rc, VPE_SHOW_NORMAL);
  965. end;
  966.  
  967. { ========================================================================
  968.                   SpeedTest
  969.   ======================================================================== }
  970.  
  971. const RPT_PATH      =  'journal.rpt';
  972.  
  973.  
  974. { ========================================================================
  975.                 Globals
  976.   ======================================================================== }
  977. const sum_amount   : Real = 0;
  978. const sum_prorated : Real = 0;
  979. const   sum_tax          : Real = 0;
  980.  
  981. {// ========================================================================
  982. //                            striplf
  983. // ========================================================================}
  984. procedure striplf(s :PChar);
  985. var i : Integer;
  986. begin
  987.    i := strlen(s)-1;
  988.    while (i>=0) and ((s[i]=#13) or (s[i]=#10)) do
  989.    begin
  990.       s[i] := #0;
  991.       dec(i);
  992.    end;
  993. end;
  994.  
  995. {// ========================================================================
  996. //                            stof
  997. // ========================================================================}
  998. function stof(s : PChar) : Real;
  999. var i : Integer;
  1000. var p : Pchar;
  1001. var R : Real;
  1002. begin
  1003.    p := s;
  1004.  
  1005.    while s^ <> #0 do
  1006.    begin
  1007.       if s^ = ',' then
  1008.      s^ := '.'
  1009.       else if s^ = '.' then
  1010.       begin
  1011.      for i := 0 to Ord(s[i])-1 do
  1012.         s[i] := s[i+1];
  1013.       end;
  1014.       inc(s);
  1015.    end;
  1016.    val(p,r,i);
  1017.    if i = 0 then
  1018.       stof := r else
  1019.        stof := 0;
  1020. end;
  1021.  
  1022.  
  1023.  
  1024.  
  1025.  
  1026.  
  1027.  
  1028. {// ========================================================================
  1029. //                            stoDM
  1030. // ========================================================================}
  1031. procedure stoDM(s : PChar);
  1032. var i,tocopy : Integer;
  1033. var beg          : boolean;
  1034. var P : Pchar;
  1035. var tmp : array[0..127] of char;
  1036.  
  1037. begin
  1038.    strcopy(tmp, s);
  1039.    p := tmp;
  1040.  
  1041.    while p^ <> #0 do
  1042.    begin
  1043.       if p^ = '.' then
  1044.      p^ := ',';
  1045.       inc(p);
  1046.    end;
  1047.  
  1048.    i := strlen(tmp) - 3;    {// 2 Nachkommastellen und tausender-punkt}
  1049.    p := tmp;
  1050.    beg := true;
  1051.    s^ := #0;
  1052.  
  1053.    while (i > 0) do
  1054.    begin
  1055.       tocopy := i mod 3;
  1056.       if (tocopy = 0) then
  1057.       begin
  1058.      if not beg then
  1059.         strcat(s, '.');
  1060.      tocopy := 3;
  1061.       end;
  1062.       s := strlcat(s, p,strlen(s)+ tocopy);
  1063.       p :=p+ tocopy;
  1064.       dec(i,tocopy);
  1065.       beg := false;
  1066.    end;
  1067.  
  1068.    strcat(s, p);
  1069. end;
  1070.  
  1071.  
  1072.  
  1073.  
  1074.  
  1075. {// ========================================================================
  1076. //                              PrintJournal
  1077. //
  1078. // Structure of input-file
  1079. // =======================
  1080. // User-Name
  1081. // Year
  1082. // Start Month (or blank)
  1083. // End Month (or blank)
  1084. // <@>Table-Name --> start a new table!!!
  1085. // No.
  1086. // Date
  1087. // Amount
  1088. // Prorated Amount
  1089. // Tax
  1090. // Remark
  1091. // Remark
  1092. //
  1093. // NOTE: In this demo Y2 has a constant value for much faster processing
  1094. //
  1095. // ========================================================================}
  1096.  
  1097. {// ========================================================================
  1098. //                              GenerateReport
  1099. // ========================================================================}
  1100. procedure GenerateReport;
  1101. var fh : Text;
  1102. var i, stepper, min, z : Integer;
  1103. const count : LongInt = 0;
  1104. const table : LongInt = 1;
  1105. begin
  1106.    Randomize;
  1107.  
  1108.    SetDlgItemText(hMainDlg, 110, 'Generating pseudo report-file...');
  1109.  
  1110.    Assign(fh,RPT_PATH);
  1111.    Rewrite(fh);
  1112.    WriteLn(fh, 'Test-Document');
  1113.    WriteLn(fh, '1996');
  1114.    WriteLn(fh);
  1115.    z := 0;
  1116.  
  1117.    while (count < 20000) do
  1118.    begin
  1119.       if z < (Random(65000) mod 5) + 10 then
  1120.       begin
  1121.      stepper := 4;
  1122.      min := 3;
  1123.       end
  1124.       else
  1125.       begin
  1126.      stepper := 21;
  1127.      min := 20;
  1128.      z := -1;
  1129.       end;
  1130.        inc(z);
  1131.       WriteLn(fh, '@Table ', table);
  1132.       inc(table);
  1133.       i := (random(65000) mod stepper) + min;
  1134.       while i > 0 do
  1135.       begin
  1136.      writeln(fh,count);
  1137.      writeln(fh,random(65000) mod 28 + 1:2,'.',random(65000) mod 12+1:02,'.95');
  1138.  
  1139.      writeln(fh,random(65000),',', random(65000) mod 100:02);
  1140.      writeln(fh,random(65000),',', random(65000) mod 100);
  1141.      writeln(fh,random(65000),',', random(65000) mod 100);
  1142.      writeln(fh);
  1143.      writeln(fh);
  1144.      inc(count,7);
  1145.      dec(i);
  1146.       end;
  1147.    end;
  1148.  
  1149.    close(fh);
  1150.  
  1151.    SetDlgItemText(hMainDlg, 110, 'Report generation finished.');
  1152. end;
  1153.  
  1154.  
  1155.  
  1156.  
  1157.  
  1158.  
  1159.  
  1160. {// ========================================================================
  1161. //                              PrintHeader
  1162. // ========================================================================}
  1163. procedure PrintHeader(hdoc : LongInt ; table : PChar);
  1164. begin
  1165.    VpeSetAlign(hdoc, ALIGN_CENTER);
  1166.    VpeSelectFont(hdoc, 'Arial', 14);
  1167.    VpeSetBkgColor(hdoc, COLOR_LTGRAY);
  1168.    VpeWriteBox(hdoc, VLEFTMARGIN, VBOTTOM, VRIGHTMARGIN, -60, table);
  1169.  
  1170.    VpeSetFontAttr(hdoc, ALIGN_CENTER, 1, 0, 0);
  1171.    VpeSelectFont(hdoc, 'Arial', 11);
  1172.    VpeWriteBox(hdoc, VLEFTMARGIN, VBOTTOM, -200, -50, 'No.');
  1173.    VpeWriteBox(hdoc, VRIGHT, VTOP, -200, VBOTTOM, 'Date');
  1174.    VpeWriteBox(hdoc, VRIGHT, VTOP, -250, VBOTTOM, 'Amount');
  1175.    VpeWriteBox(hdoc, VRIGHT, VTOP, -250, VBOTTOM, 'Prorated Amount');
  1176.    VpeWriteBox(hdoc, VRIGHT, VTOP, -250, VBOTTOM, 'Tax');
  1177.    VpeWriteBox(hdoc, VRIGHT, VTOP, VRIGHTMARGIN, VBOTTOM, 'Remark');
  1178.    VpeSetFontAttr(hdoc, ALIGN_LEFT, 0, 0, 0);
  1179.    VpeSetBkgColor(hdoc, RGB(255, 255, 255));
  1180. end;
  1181.  
  1182.  
  1183.  
  1184.  
  1185. {// ========================================================================
  1186. //                              PrintFooter
  1187. // ========================================================================}
  1188. procedure PrintFooter(hdoc : LongInt);
  1189. var s : array[0..19] of char;
  1190.  
  1191. begin
  1192.    VpeSetFontAttr(hdoc, ALIGN_CENTER, 1, 0, 0);
  1193.    VpeSetBkgColor(hdoc, COLOR_LTGRAY);
  1194.    VpeWriteBox(hdoc, VLEFTMARGIN, VBOTTOM, -400, -50, 'Sum');
  1195.    VpeSetFontAttr(hdoc, ALIGN_RIGHT, 1, 0, 0);
  1196.    Str(sum_amount:1:2,s);
  1197.    stoDM(s);
  1198.    VpeWriteBox(hdoc, VRIGHT, VTOP, -250, VBOTTOM, s);
  1199.    Str(sum_prorated:1:2,s);
  1200.    stoDM(s);
  1201.    VpeWriteBox(hdoc, VRIGHT, VTOP, -250, VBOTTOM, s);
  1202.    Str(sum_tax:1:2,s);
  1203.    stoDM(s);
  1204.    VpeWriteBox(hdoc, VRIGHT, VTOP, -250, VBOTTOM, s);
  1205.    VpeWriteBox(hdoc, VRIGHT, VTOP, VRIGHTMARGIN, VBOTTOM, '');
  1206.    VpeSetFontAttr(hdoc, ALIGN_LEFT, 0, 0, 0);
  1207.    VpeSetBkgColor(hdoc, RGB(255, 255, 255));
  1208. end;
  1209.  
  1210.  
  1211.  
  1212.  
  1213.  
  1214. {// ========================================================================
  1215. //                              PrintFoot
  1216. // ========================================================================}
  1217. procedure PrintPageFooter(hdoc : LongInt; name : PChar; page : Integer );
  1218. var buf : array[0..31] of char;
  1219.  
  1220. begin
  1221.  
  1222.    VpeStorePos(hdoc);
  1223.    VpeNoPen(hdoc);
  1224.    VpeWriteBox(hdoc, VLEFTMARGIN, VBOTTOMMARGIN, VpeGet(hdoc, VRIGHTMARGIN) - 400, -50, name);
  1225.    wvsprintf(buf, 'Journal Page %d', page);
  1226.    VpeSetAlign(hdoc, ALIGN_RIGHT);
  1227.    VpeWriteBox(hdoc, VRIGHT, VBOTTOMMARGIN, VRIGHTMARGIN, -50, buf);
  1228.    VpeSetPen(hdoc, 3, PS_SOLID, COLOR_BLACK);
  1229.    VpeRestorePos(hdoc);
  1230. end;
  1231.  
  1232.  
  1233.  
  1234.  
  1235.  
  1236.  
  1237. {// ========================================================================
  1238. //                              PageBreak
  1239. // ========================================================================}
  1240. procedure PageBreak(hdoc : LongInt; page : Integer);
  1241. var z : array[0..79] of char;
  1242.  
  1243. begin
  1244.  
  1245.  
  1246.    VpePageBreak(hdoc);
  1247.  
  1248.    if (page mod 10 = 0) then
  1249.    begin
  1250.       wvsprintf(z, 'now reading inputfile and generating page %d', page);
  1251.       SetDlgItemText(hMainDlg, 110, z);
  1252.    end;
  1253. end;
  1254.  
  1255.  
  1256.  
  1257.  
  1258.  
  1259. {// ========================================================================
  1260. //                              PrintJournal
  1261. // ========================================================================}
  1262. function PrintJournal : Boolean;
  1263. var hdoc : LongInt;
  1264. var fh  : Text;
  1265. var s   : array[0..255] of char;
  1266. var buf : array[0..513] of char;
  1267. var name : array[0..79] of char;
  1268. var year : array[0..7] of char;
  1269. var period : array[0..31] of char;
  1270. var table  : array[0..128] of char;
  1271. const footer_ok : Boolean = FALSE;
  1272. const page : Integer = 1;
  1273. var   hOldCursor : HCURSOR ;
  1274. var i : Integer;
  1275. begin
  1276.  
  1277.    PrintJournal := false;
  1278.    hOldCursor := SetCursor(LoadCursor(0, IDC_WAIT));
  1279.    Assign(fh,RPT_PATH);
  1280.    Reset(fh);
  1281.    if IOResult <> 0 then
  1282.    begin
  1283.       SetDlgItemText(hMainDlg, 110, 'ERROR: Report-file not found!');
  1284.       EXIT;
  1285.    end;
  1286.  
  1287.    hdoc := VpeOpenDoc(hMainWindow, 'Speed + Tables', -1, -1, VPE_GRID_POSSIBLE);
  1288.    Speed := hdoc;
  1289.    VpeSetAutoBreak(hdoc, AUTO_BREAK_NO_LIMITS);
  1290.    VpeSetTransparentMode(hdoc, 0);
  1291.  
  1292.  
  1293.    {// Read constant data block:
  1294.    // =========================}
  1295.    ReadLn(fh,name);
  1296.    striplf(name);
  1297.    ReadLn(fh,year);
  1298.    striplf(year);
  1299.    ReadLn(fh,s);
  1300.    striplf(s);
  1301.  
  1302.    if (strlen(s) > 0) then
  1303.    begin
  1304.       if (strlcomp(s, 'Month', 5) = 0) then     { // if 'Month' possibly eliminate 2 Blanks}
  1305.       begin
  1306.      if (s[7] = ' ') then
  1307.      begin
  1308.         s[6] := s[8];
  1309.         s[7] := #0;
  1310.      end;
  1311.       end;
  1312.       strcopy(period, ', ');
  1313.       strcat(period, s);
  1314.    end
  1315.    else
  1316.       period[0] := #0;
  1317.  
  1318.    strcat(strcat(strcopy(s, 'Journal '),year), period);
  1319.    VpeSetPen(hdoc, 0, 0, COLOR_BLACK);
  1320.    VpeSetFontAttr(hdoc, ALIGN_CENTER, 0, 1, 0);
  1321.    VpeSelectFont(hdoc, 'Arial', 16);
  1322.    VpeWriteBox(hdoc, VLEFTMARGIN, VTOPMARGIN, VRIGHTMARGIN, VFREE, s);
  1323.  
  1324.    VpeSetPen(hdoc, 3, PS_SOLID, COLOR_BLACK);
  1325.    VpeSetFontAttr(hdoc, ALIGN_LEFT, 0, 0, 0);
  1326.    VpeSelectFont(hdoc, 'Arial', 11);
  1327.  
  1328.    {// process variable data:
  1329.    // ======================}
  1330.    while not EOF(fh) do
  1331.  
  1332.    begin
  1333.       REadLn(fh,s);
  1334.       if IOResult <> 0 then BREAK;
  1335.       striplf(s);
  1336.       if (s[0] = '@') then
  1337.       begin
  1338.      {// Beginning of a new table:
  1339.      // =========================}
  1340.      if (footer_ok) then
  1341.         PrintFooter(hdoc);
  1342.      sum_tax:=0;
  1343.      sum_prorated:=0;
  1344.      sum_amount:=0;
  1345.  
  1346.      {// Is the room to the page-bottom big enough for a new table ?}
  1347.      if (VpeGet(hdoc, VBOTTOMMARGIN) - VpeGet(hdoc, VBOTTOM) < 400) then
  1348.      begin
  1349.         {// No, add a new page:}
  1350.         PrintPageFooter(hdoc, name, page);
  1351.         PageBreak(hdoc, page);
  1352.         inc(page);
  1353.      end
  1354.      else
  1355.      begin
  1356.         {// Beginning of new table is 1cm below previous table:}
  1357.         VpeSet(hdoc, VBOTTOM, VpeGet(hdoc, VBOTTOM) + 100);
  1358.      end;
  1359.      strcopy(table, s+1);
  1360.      PrintHeader(hdoc, table);
  1361.      footer_ok := FALSE;
  1362.       end
  1363.       else
  1364.       begin
  1365.      {// list part:
  1366.      // ==========}
  1367.      footer_ok := TRUE;
  1368.      VpeSetTransparentMode(hdoc, 1);
  1369.      VpeSetAlign(hdoc, ALIGN_RIGHT);
  1370.      VpeWriteBox(hdoc, VLEFTMARGIN, VBOTTOM, -200, -50, s);
  1371.  
  1372.      REadLn(fh,s);
  1373.      striplf(s);
  1374.      VpeWriteBox(hdoc, VRIGHT, VTOP, -200, VBOTTOM, s);
  1375.  
  1376.      readLn(fh,s);
  1377.      striplf(s);
  1378.      sum_amount := sum_amount+stof(s);
  1379.      stoDM(s);
  1380.      VpeWriteBox(hdoc, VRIGHT, VTOP, -250, VBOTTOM, s);
  1381.  
  1382.      ReadLn(fh,s);
  1383.      striplf(s);
  1384.      sum_prorated := sum_prorated+stof(s);
  1385.      stoDM(s);
  1386.      VpeWriteBox(hdoc, VRIGHT, VTOP, -250, VBOTTOM, s);
  1387.  
  1388.      ReadLn(fh,s);
  1389.      striplf(s);
  1390.      sum_tax := sum_tax+stof(s);
  1391.      stoDM(s);
  1392.      VpeWriteBox(hdoc, VRIGHT, VTOP, -250, VBOTTOM, s);
  1393.  
  1394.      ReadLn(fh,s);
  1395.      striplf(s);
  1396.      strcopy(buf, s);
  1397.      strcat(buf, ' ');
  1398.      ReadLn(fh,s);
  1399.      striplf(s);
  1400.      strcat(buf, s);
  1401.      VpeSetAlign(hdoc, ALIGN_LEFT);
  1402.      VpeSelectFont(hdoc, 'Arial', 6);
  1403.      VpeWriteBox(hdoc, VRIGHT, VTOP, VRIGHTMARGIN, VBOTTOM, buf);
  1404.      VpeSelectFont(hdoc, 'Arial', 11);
  1405.      VpeSetTransparentMode(hdoc, 0);
  1406.  
  1407.      if (VpeGet(hdoc, VBOTTOM) + 150 > VpeGet(hdoc, VBOTTOMMARGIN)) then
  1408.      begin
  1409.         {// Bottom of page reached:
  1410.         // =======================}
  1411.         PrintFooter(hdoc);
  1412.         PrintPageFooter(hdoc, name, page);
  1413.         PageBreak(hdoc, page);
  1414.         inc(page);
  1415.         PrintHeader(hdoc, table);
  1416.      end;
  1417.       end; {// else}
  1418.    end; {// while}
  1419.  
  1420.    Close(fh);
  1421.  
  1422.    PrintFooter(hdoc);
  1423.    PrintPageFooter(hdoc, name, page);
  1424.  
  1425.    VpeGotoPage(hdoc, 1);
  1426.    i := VpeGetPageCount(hdoc);
  1427.    wvsprintf(s, 'Generated %d pages out of textfile!', i);
  1428.    VpeWriteBox(hdoc, 100, 100, 1000, 150, s);
  1429.  
  1430.    SetCursor(hOldCursor);
  1431.    SetDlgItemText(hMainDlg, 110, '');
  1432.  
  1433.  
  1434.    VpePreviewDoc(hdoc, nil, VPE_SHOW_MAXIMIZED);
  1435.  
  1436.    PrintJournal := true;
  1437. end;
  1438.  
  1439.  
  1440.  
  1441. const szAppName  = 'VPE';
  1442.  
  1443. const ID_PRECISION  = 100;
  1444. const ID_CPRECISION = 111;
  1445. const ID_PAGE_LEFT  = 888;
  1446. const ID_PAGE_RIGHT = 889;
  1447. const ID_PBACKGND         = 200;
  1448. const ID_GENERATE         = 900;
  1449. const ID_REMOVEREP  = 901;
  1450. const ID_SPEED            = 101;
  1451. const ID_CSPEED   = 112;
  1452. const ID_COLORS   = 102;
  1453. const ID_CCOLORS          = 113;
  1454. const ID_REPORT   = 902;
  1455. const ID_CREPORT          = 904;
  1456. var   F : TExt;
  1457. {// ========================================================================
  1458. //                              DlgSelectProc
  1459. // ========================================================================}
  1460.  
  1461. function DlgSelectProc(hDlg : HWND;message : Word;wParam : Word; lParam : LongInt) : Bool;export;
  1462.  
  1463. begin
  1464.    DlgSelectProc := False;
  1465.    case message of
  1466.     WM_INITDIALOG:
  1467.      begin
  1468.        hMainDlg := hDlg;
  1469.        DlgSelectProc := True;
  1470.        EXIT;
  1471.      end;
  1472.  
  1473.    WM_COMMAND:
  1474.      begin
  1475.        SetDlgItemText(hMainDlg, 110, '');
  1476.        case wParam of
  1477.      ID_PRECISION:
  1478.          if (Precision <> 0) then
  1479.         SetDlgItemText(hMainDlg, 110, 'Precision test is already running')
  1480.          else
  1481.          begin
  1482.         SetDlgItemText(hMainDlg, 110, 'The window titled ''VPE'' is the applications main window.'+
  1483.                      ' It''s content is an embedded window from the VPE-DLL!!! You just need about 12 lines of code!');
  1484.         precisiondemo(0);
  1485.         EnableWindow(GetDlgItem(hMainDlg, ID_CPRECISION), TRUE);
  1486.         EnableWindow(GetDlgItem(hMainDlg, ID_PAGE_LEFT), TRUE);
  1487.         EnableWindow(GetDlgItem(hMainDlg, ID_PAGE_RIGHT), TRUE);
  1488.          end;
  1489.  
  1490.  
  1491.       ID_CPRECISION:
  1492.          if (VpeCloseDoc(Precision)=0) then
  1493.         SetDlgItemText(hMainDlg, 110, 'Can''t close, task ''precision test'' is currently printing');
  1494.  
  1495.       ID_PAGE_LEFT:
  1496.        begin
  1497.          VpeSetUpdate(Precision, 1);
  1498.          VpeGotoPage(Precision, VpeGetCurrentPage(Precision)-1);
  1499.          VpeSetUpdate(Precision, 0);
  1500.        end;
  1501.  
  1502.       ID_PAGE_RIGHT:
  1503.        begin
  1504.          VpeSetUpdate(Precision, 1);
  1505.          VpeGotoPage(Precision, VpeGetCurrentPage(Precision)+1);
  1506.          VpeSetUpdate(Precision, 0);
  1507.        end;
  1508.  
  1509.       ID_PBACKGND:
  1510.         begin
  1511.           SetDlgItemText(hMainDlg, 110, 'Here no preview is shown.'+
  1512.                   ' Also no printer-setup is done - setting of the standrd printer or of your last setup in VPE are taken');
  1513.           EnableWindow(GetDlgItem(hMainDlg, ID_PBACKGND), FALSE);
  1514.           precisiondemo(1);
  1515.         end;
  1516.  
  1517.  
  1518.       ID_GENERATE: GenerateReport;
  1519.  
  1520.       ID_REMOVEREP: begin
  1521.                          Assign(F,RPT_PATH);
  1522.                                   Erase(F);
  1523.             end;
  1524.  
  1525.       ID_SPEED:
  1526.        begin
  1527.          if Speed <> 0 then
  1528.         SetDlgItemText(hMainDlg, 110, 'Speed test is already running')
  1529.          else
  1530.          begin
  1531.         if PrintJournal then
  1532.            EnableWindow(GetDlgItem(hMainDlg, ID_CSPEED), TRUE);
  1533.          end;
  1534.        end;
  1535.  
  1536.       ID_CSPEED:
  1537.          if VpeCloseDoc(Speed)=0 then
  1538.         SetDlgItemText(hMainDlg, 110, 'Can''t close, task ''speed test'' is currently printing');
  1539.  
  1540.       ID_COLORS:
  1541.          if (Colors <> 0 ) then
  1542.         SetDlgItemText(hMainDlg, 110, 'Color test is already running')
  1543.          else
  1544.          begin
  1545.         colortest;
  1546.         EnableWindow(GetDlgItem(hMainDlg, ID_CCOLORS), TRUE);
  1547.          end;
  1548.  
  1549.       ID_CCOLORS:
  1550.          if (VpeCloseDoc(Colors)=0) then
  1551.         SetDlgItemText(hMainDlg, 110, 'Can''t close, task ''color test'' is currently printing');
  1552.  
  1553.  
  1554.       ID_REPORT:
  1555.          if (Report <> 0) then
  1556.         SetDlgItemText(hMainDlg, 110, 'Report test is already running')
  1557.          else
  1558.          begin
  1559.         reporttest;
  1560.         EnableWindow(GetDlgItem(hMainDlg, ID_CREPORT), TRUE);
  1561.          end;
  1562.  
  1563.       ID_CREPORT:
  1564.          if (VpeCloseDoc(Report) = 0) then
  1565.         SetDlgItemText(hMainDlg, 110, 'Can''t close, task ''report test'' is currently printing');
  1566.       IDOK,
  1567.       IDCANCEL:
  1568.        begin
  1569.          if (SendMessage(hMainWindow, WM_CLOSE, 0, 0) <> 0) then
  1570.          begin
  1571.         EndDialog(hDlg, 0);
  1572.          end;
  1573.          EXIT;
  1574.       end;
  1575.        end;
  1576.      end;
  1577.    end;
  1578.  
  1579.  
  1580. end;
  1581.  
  1582.  
  1583.  
  1584.  
  1585.  
  1586.  
  1587. {// ========================================================================
  1588. //                              WndProc
  1589. // ========================================================================}
  1590. var  no_close  : Integer;
  1591.  
  1592. function WndProc(Window: HWnd; Message, WParam: Word;
  1593.   LParam: Longint): Longint; export;
  1594. var  lpfnDlgProc : TFARPROC;
  1595. begin
  1596.    case message of
  1597.     WM_CREATE:
  1598.        begin
  1599.      no_close := 0;
  1600.      hMainWindow := Window;
  1601.      lpfnDlgProc := MakeProcInstance (@DlgSelectProc, hInstance);
  1602.      CreateDialog(hInstance, 'DLG_TEST', Window, lpfnDlgProc);
  1603.      WndProc := 0;
  1604.      EXIT;
  1605.        end;
  1606.  
  1607.        VPE_DESTROYWINDOW:
  1608.     begin
  1609.      if (Precision = lParam) then
  1610.      begin
  1611.         Precision := 0;
  1612.         EnableWindow(GetDlgItem(hMainDlg, ID_CPRECISION), FALSE);
  1613.         EnableWindow(GetDlgItem(hMainDlg, ID_PAGE_LEFT), FALSE);
  1614.         EnableWindow(GetDlgItem(hMainDlg, ID_PAGE_RIGHT), FALSE);
  1615.      end
  1616.      else if (Speed = lParam) then
  1617.      begin
  1618.         Speed := 0;
  1619.         EnableWindow(GetDlgItem(hMainDlg, ID_CSPEED), FALSE);
  1620.      end
  1621.      else if (Colors = lParam) then
  1622.      begin
  1623.         Colors := 0;
  1624.         EnableWindow(GetDlgItem(hMainDlg, ID_CCOLORS), FALSE);
  1625.      end
  1626.      else if (Report = lParam) then
  1627.      begin
  1628.         Report := 0;
  1629.         EnableWindow(GetDlgItem(hMainDlg, ID_CREPORT), FALSE);
  1630.      end;
  1631.        end;
  1632.  
  1633.  
  1634.       VPE_PRINT,
  1635.       VPE_PRINTCANCEL:
  1636.     begin
  1637.      if wParam <> 0 then
  1638.      begin
  1639.         inc(no_close);
  1640.      end
  1641.      else
  1642.      begin
  1643.         dec(no_close);
  1644.         if (lParam = PBackGnd) then
  1645.         begin
  1646.            VpeCloseDoc(PBackGnd);
  1647.            PBackGnd := 0;
  1648.            EnableWindow(GetDlgItem(hMainDlg, ID_PBACKGND), TRUE);
  1649.            if (message = VPE_PRINT) then
  1650.           SetDlgItemText(hMainDlg, 110, 'Message: Background-Processing finished.')
  1651.            else
  1652.           SetDlgItemText(hMainDlg, 110, 'Message: Background-Processing aborted.');
  1653.         end;
  1654.      end;
  1655.      WndProc := 0;
  1656.        end;
  1657.  
  1658.  
  1659.       VPE_HELP: MessageBox(Window, 'User requested help!', 'Note:', MB_OK);
  1660.  
  1661.       WM_SIZE:
  1662.        begin
  1663.      if Precision <> 0 then  { // this is an embedded window}
  1664.      begin
  1665.         MoveWindow(VpeWindowHandle(Precision), 0, 0, LOWORD(lParam), HIWORD(lParam), FALSE);
  1666.      end;
  1667.      WndProc := 0;
  1668.        end;
  1669.  
  1670.  
  1671.       WM_KEYDOWN:
  1672.        begin
  1673.      if Precision <> 0 then  {// this is an embedded window}
  1674.      begin
  1675.         SendMessage(VpeWindowHandle(Precision), WM_KEYDOWN, wParam, lParam);
  1676.      end;
  1677.      WndProc := 0;
  1678.        end;
  1679.  
  1680.       WM_CLOSE:
  1681.     begin
  1682.      if (no_close= 0) then    { // can't close, because printing?}
  1683.      begin
  1684.         DestroyWindow(Window);
  1685.         WndProc := 1;
  1686.      end;
  1687.      MessageBox(Window, 'Can''t close, job is printing!', 'WARNING:', MB_OK);
  1688.      WndProc := 0;
  1689.        end;
  1690.  
  1691.  
  1692.       WM_DESTROY:
  1693.        begin
  1694.      PostQuitMessage(0);
  1695.      WndProc :=0;
  1696.        end;
  1697.      else WndProc := DefWindowProc (Window, message, wParam, lParam) ;
  1698.    end;
  1699.  
  1700. end;
  1701.  
  1702.  
  1703. {// ========================================================================
  1704. //                              WinMain
  1705. // ========================================================================}
  1706.  
  1707.  
  1708.  
  1709. procedure WinMain;
  1710.  
  1711. var  msg : TMSG;
  1712. var Window : HWnd;
  1713. var wndclass : TWndClass;
  1714.  
  1715. begin
  1716.  
  1717.    if HPrevInst = 0 then
  1718.    begin
  1719.       wndclass.style         := CS_HREDRAW or CS_VREDRAW ;
  1720.       wndclass.lpfnWndProc   := @WndProc ;
  1721.       wndclass.cbClsExtra    := 0 ;
  1722.       wndclass.cbWndExtra    := 0 ;
  1723.       wndclass.hInstance     := hInstance ;
  1724.       wndclass.hIcon         := LoadIcon (hInstance, 'APP_ICON');
  1725.       wndclass.hCursor       := LoadCursor (0, IDC_ARROW) ;
  1726.       wndclass.hbrBackground := GetStockObject (WHITE_BRUSH) ;
  1727.       wndclass.lpszMenuName  := szAppName ;
  1728.       wndclass.lpszClassName := szAppName ;
  1729.       RegisterClass(wndclass) ;
  1730.    end;
  1731.  
  1732.    Window := CreateWindow(szAppName, szAppName,
  1733.                WS_OVERLAPPEDWINDOW,
  1734.                CW_USEDEFAULT, CW_USEDEFAULT,
  1735.                CW_USEDEFAULT, CW_USEDEFAULT,
  1736.                0, 0, hInstance, nil) ;
  1737.  
  1738.    ShowWindow (Window, CmdShow) ;
  1739.    UpdateWindow (Window) ;
  1740.  
  1741.    while GetMessage(Msg, 0, 0, 0) do
  1742.    begin
  1743.      TranslateMessage(Msg);
  1744.      DispatchMessage(Msg);
  1745.    end;
  1746.    Halt(Msg.wParam);
  1747. end;
  1748.  
  1749. begin
  1750.   SetDemoText;
  1751.   WinMain;
  1752. end.
  1753.  
  1754.