home *** CD-ROM | disk | FTP | other *** search
/ DOKAN 17 / DOKAN17.iso / Progs / Pjv03dde.zip / PJV03DDE / SRCCODE / SAMPLE3 / JVIEWU.PAS < prev    next >
Pascal/Delphi Source File  |  1999-08-29  |  23KB  |  806 lines
  1. unit jviewu;
  2.  
  3. // Pulsar jViewer Source Code (c)1999 Pulsar Studio, & Lord Trancos.
  4. // Please distribute the source code without any modification.
  5.  
  6. // FREEWARE
  7.  
  8. interface
  9.  
  10. uses
  11.   Windows, Messages, SysUtils, Classes, Graphics, Controls,
  12.   Forms, Dialogs, Printers, Nihongo, StdCtrls;
  13.  
  14. type
  15.   TForm1 = class(TForm)
  16.     OpenDlg: TOpenDialog;
  17.     PrtDlg: TPrintDialog;
  18.     procedure FormCreate(Sender: TObject);
  19.     procedure FormPaint(Sender: TObject);
  20.     procedure FormKeyDown(Sender: TObject; var Key: Word;
  21.       Shift: TShiftState);
  22.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  23.   private
  24.     { Private declarations }
  25.   public
  26.     { Public declarations }
  27.   end;
  28.  
  29. var
  30.   Form1  : TForm1;
  31.   ChrSiz : word;             // Charcter width n height
  32.   ChrX   : longint;          // Left OffSet for Scroll L/R
  33.   LinScr : word;             // Lines in Screen
  34.   ChrScr : word;             // Max Char per Line
  35.   lAdjust : boolean = true;  // Use Line break
  36.   PrtChrScr : word;          // Max Chr per Line (Printer)
  37.  
  38.   // File vars
  39.   FFormat : byte;    // File format = 0 -> sjs / 1 -> euc / 2 ->jis
  40.   JISON   : boolean = false;
  41.   FName   : string;  // Filename
  42.   FSize   : longint; // File size
  43.   FData   : pointer; // File in memory
  44.   FLoaded : boolean; // File loaded ?
  45.   FLin    : longint; // First line drawed
  46.   FLines  : longint; // Used to limit movement
  47.   FPos    : longint; // File position
  48.   FPages  : longint; // File Pages
  49.  
  50. const
  51.   EOFDOS = $D;  // Do not change
  52.   EOFWIN = $A;  // Do not change
  53.   MINCHR = 20;  // Min. Number of Chars. per Line Printed
  54.   MAXCHR = 140; // Max. Number of Chars. per Line Printed
  55.  
  56.   EUCEXT = '.EUC';  // default EUC extension
  57.   SJSEXT = '.SJS';  // default SJS extension
  58.   JISEXT = '.JIS';  // default JIS extension
  59.   USEEUC = '-E'; // 2nd parameter, EUC (only required if file ext <> EUCEXT)
  60.   USESJS = '-S'; // 2nd parameter, SJS (only required if file ext <> SJSEXT)
  61.   USEJIS = '-J'; // 2nd parameter, JIS (only required if file ext <> JISEXT)
  62.  
  63.   ABOUT = 'Pulsar jViewer v0.3d - SJS/EUC/JIS Viewer'+#10+
  64.           '(c)1999 Pulsar Studio'+#10+
  65.           'Developed by Lord Trancos'+#10+
  66.           ''+#10+'Keys;'+#10+
  67.           '[ESC] - Exit'+#10+
  68.           '[F1] - About/Help'+#10+
  69.           '[F2] - Open File'+#10+
  70.           '[F5] - Enable/Disable Line Break'+#10+
  71.           '[F8] - Minimize Window'+#10+
  72.           '[F9] - Change Max. Number of Chars. per Line Printed'+#10+
  73.           '[F10] - Print File'+#10+
  74.           '[UP][DOWN] - Scroll Up/Down'+#10+
  75.           '[LEFT][RIGHT] - Scroll Left/Right'+#10+
  76.           '[PGUP] - Page Up'+#10+
  77.           '[PGDOWN] - Page Down'+#10+
  78.           '[SPACEBAR] - Redraw Text'+#10+
  79. {          '[BACKSPACE] - Change Between EUC/SJS'+#10+}#10+ 
  80.           'Greetings to:'+#10+
  81.           'Dark Shadow, R⌠nin, Multidimensional Careto,'+#10+
  82.           'Takuya, Kanjiman, FidoNet r34.Japones, FIC BBS,'+#10+
  83.           'DOKAN and ONELIST.COM MLJ (Mail List Japones)'+#10+#10+
  84.           'This program is FREEWARE' + #10+
  85.           'Full Source Code is Available for FREE!';
  86.  
  87.   TXT00 = 'Can not open file: ';
  88.   TXT01 = 'Can not load file: ';
  89.   TXT02 = 'Error while initializing Nihongo Engine!'+#10+
  90.           '(Remerber: '+jJAPFNT+' and '+jASCFNT+
  91.           ' must be in program''s folder!)';
  92.   TXT03 = '>> LOADING';
  93.   TXT04 = 'File empty: ';
  94.   TXT05 = ' PULSAR jVIEWER - ';
  95.   TXT06 = 'File format not specified.';
  96.   TXT07 = ' - page: ';
  97.   TXT08 = ' - line: ';
  98.   TXT09 = 'Top/Left: (';
  99.   TXT10 = ') - Pos: ';
  100.   TXT11 = 'Printing... ';
  101.   TXT12 = 'Counting... ';
  102.   TXT13 = '%';
  103.   TXT15 = 'Lines: ';
  104.   TXT16 = 'Skiping ';
  105.   TXT17 = 'Printing ';
  106.   TXT18 = 'Change number of characters per line';
  107.   TXT19 = 'How many (range: 20-140)?';
  108.   TXT20 = 'Out of range!';
  109.   NHG00 = #$93 + #$FA + #$96 + #$7B + #$8C + #$EA;
  110.  
  111. implementation
  112.  
  113. uses jViewu2;
  114.  
  115. {$R *.DFM}
  116.  
  117. // -----------------------------------------------------------------------
  118.  
  119. procedure ErrH(_err: string);
  120.  
  121. begin
  122.   MessageDlg(_err, mtError, [mbOk], 0);
  123.   Halt;
  124. end;
  125.  
  126. // -----------------------------------------------------------------------
  127.  
  128. procedure IncPtrPox(var _ptr: pointer; var _pos: longint; _val: longint);
  129.  
  130. begin
  131.   inc(longint(_ptr), _val);
  132.   inc(_pos, _val);
  133. end;
  134.  
  135. // -----------------------------------------------------------------------
  136.  
  137. procedure DecPtrPox(var _ptr: pointer; var _pos: longint; _val: longint);
  138.  
  139. begin
  140.   dec(longint(_ptr), _val);
  141.   dec(_pos, _val);
  142. end;
  143.  
  144. // -----------------------------------------------------------------------
  145.  
  146. procedure CheckJIS(var _ptr: pointer; var _pos: longint);
  147.  
  148. begin
  149.   if byte(_ptr^) = $1B then
  150.     begin
  151.       if JISON = true
  152.         then JISON := false
  153.           else JISON := true;
  154.       IncPtrPox(_ptr, _pos, 3);
  155.     end;
  156. end;
  157.  
  158. // -----------------------------------------------------------------------
  159.  
  160. function GetCurrentLine(var _ptr: pointer; var _pos: longint;
  161.                         _chrscr: word): string;
  162.  
  163. var _s: string;
  164.     _l: longint;
  165.     _b: byte;
  166.     _z: word;
  167.  
  168. begin
  169.   _l := 0;
  170.   _s := '';
  171.  
  172.   if lAdjust = false then // Whitout Line break
  173.     begin
  174.       while (byte(_ptr^) <> EOFDOS) and (byte(_ptr^) <> EOFWIN)
  175.         and (_pos < FSize) do
  176.           begin
  177.             inc(_l);
  178.  
  179.             if FFormat = 2 then CheckJIS(_ptr, _pos);
  180.  
  181.             if (byte(_ptr^) <> EOFDOS) and (byte(_ptr^) <> EOFWIN)
  182.             and (_l >= ChrX) and (length(_s) <= _chrScr) then
  183.               if JISON = false then _s := _s + char(_ptr^)
  184.                 else _s := _s + char(byte(_ptr^)+128);
  185.  
  186.             IncPtrPox(_ptr, _pos, 1);
  187.           end;
  188.     end else begin        // Whit Line break
  189.                while (byte(_ptr^) <> EOFDOS) and (byte(_ptr^) <> EOFWIN)
  190.                  and (_pos < FSize) and (length(_s) <= _chrScr) do
  191.                    begin
  192.                      inc(_l);
  193.  
  194.                      if FFormat = 2 then CheckJIS(_ptr, _pos);
  195.  
  196.                      if (_l >= ChrX) and (byte(_ptr^) <> EOFDOS)
  197.                        and (byte(_ptr^) <> EOFWIN)then
  198.                          if JISON = false then _s := _s + char(_ptr^)
  199.                            else _s := _s + char(byte(_ptr^)+128);
  200.  
  201.                      IncPtrPox(_ptr, _pos, 1);
  202.                    end;
  203.  
  204.                if (length(_s) = _chrScr + 1)
  205.                  then DecPtrPox(_ptr, _pos, 1);
  206.  
  207.                if (length(_s) = _chrScr + 1) then
  208.                  begin
  209.                    _z := length(_s);
  210.                    _s := jBreakSJS(_s, _chrScr);
  211.                    if length(_s) < _z
  212.                      then DecPtrPox(_ptr, _pos, _z - length(_s) - 1);
  213.                  end;
  214.  
  215.                if char(_ptr^) = ' ' then IncPtrPox(_ptr, _pos, 1);
  216.              end;
  217.  
  218.   case byte(_ptr^) of
  219.     EOFDOS : _b := 2;
  220.     EOFWIN : _b := 1;
  221.     else _b := 0;
  222.   end;
  223.  
  224.   if _pos = FSize
  225.     then FLines := FLin else IncPtrPox(_ptr, _pos, _b);
  226.  
  227.   GetCurrentLine := _s;
  228. end;
  229.  
  230. // -----------------------------------------------------------------------
  231.  
  232. procedure DrawText(_zeta: byte);
  233.  
  234. var _line  : byte;
  235.     _s     : string;
  236.     _point : pointer;
  237.     _pos   : longint;
  238.     _y     : longint;
  239.     _perc  : longint;
  240.  
  241. begin
  242.   _perc := (FPos * 100) div FSize;
  243.   _s := TXT05 + FName + ' - ' + TXT09 + IntToStr(FLin) + '/' + IntToStr(ChrX)
  244.       + TXT10 + IntToStr(FPos) + ' (' + IntToStr(_perc) + '%) ';
  245.   if lAdjust = true then _s := _s + 'B ';
  246.   jWriteSJS(0, 0, ChrSiz, ChrSiz, _s, false, true, Form1.Canvas.handle);
  247.   _line  := 1;
  248.   _pos   := FPos;
  249.   _point := FData;
  250.   inc(longint(_point), _pos);
  251.   repeat
  252.     _s := GetCurrentLine(_point, _pos, ChrScr);
  253.     if (_zeta = 0) or                         // Draw all
  254.        ((_zeta = 1) and (_line = 1)) or       // Draw only first line
  255.        ((_zeta = 2) and (_line = LinScr - 1)) // Draw only last line
  256.        then begin
  257.               _y := _line * ChrSiz;
  258.               if FFormat = 0
  259.                 then jWriteSJS(0, _y, ChrSiz, ChrSiz, _s,
  260.                                false, false, Form1.Canvas.handle)
  261.                   else jWriteEUC(0, _y, ChrSiz, ChrSiz, _s,
  262.                                  false, false, Form1.Canvas.handle);
  263.             end;
  264.     inc(_line);
  265.   until _line = LinScr;
  266. end;
  267.  
  268. // -----------------------------------------------------------------------
  269.  
  270. procedure LineBack(var _ptr: pointer; var _pos: longint);
  271.  
  272. begin
  273.   if (FPos = 0) or (Flin = 1) then exit;
  274.  
  275.   if (FPos > 2) then
  276.     begin
  277.       dec(longint(_ptr), 2);
  278.       dec(_pos, 2);
  279.     end else begin FPos := 0; _ptr := FData; exit; end;
  280.  
  281.   while (byte(_ptr^) <> EOFWIN) and (FPos > 0) do
  282.     begin
  283.       dec(longint(_ptr));
  284.       dec(_pos);
  285.     end;
  286.  
  287.   if FPos <> 0 then
  288.     begin
  289.       inc(longint(_ptr));
  290.       inc(_pos);
  291.     end;
  292. end;
  293.  
  294. // -----------------------------------------------------------------------
  295.  
  296. procedure LineBack2(var _ptr: pointer; var _pos: longint);
  297.  
  298. var _old   : longint;
  299.     _z, _c : longint;
  300.  
  301. begin
  302.   _z   := 0;
  303.   _old := _pos;
  304.   LineBack(_ptr, _pos);
  305.   while _pos <> _old do
  306.       begin
  307.         GetCurrentLine(_ptr, _pos, ChrScr);
  308.         inc(_z);
  309.       end;
  310.     LineBack(_ptr, _pos);
  311.     if _z > 1 then for _c := 1 to _z - 1 do GetCurrentLine(_ptr, _pos, ChrScr);
  312. end;
  313.  
  314. // -----------------------------------------------------------------------
  315.  
  316. function LineDown: boolean;
  317.  
  318. var _p: pointer;
  319.     _x: longint;
  320.  
  321. begin
  322.   LineDown := false;
  323.  
  324.   if Flines <> 0 then if FLin >= FLines then exit;
  325.   _x := FPos;
  326.   _p := FData;
  327.   inc(longint(_p), FPos);
  328.   GetCurrentLine(_p, FPos, ChrScr);
  329.   if FPos > _x then inc(FLin);
  330.  
  331.   LineDown := true;
  332. end;
  333.  
  334. // -----------------------------------------------------------------------
  335.  
  336. function LineUp: boolean;
  337.  
  338. var _p: pointer;
  339.     _x: longint;
  340.  
  341. begin
  342.   LineUp := false;
  343.  
  344.   if FLin = 1 then exit;
  345.   _x := FPos;
  346.   _p := FData;
  347.   inc(longint(_p), FPos);
  348.   if lAdjust = false
  349.     then LineBack(_p, FPos)
  350.       else LineBack2(_p, FPos);
  351.   if FPos < _x then dec(FLin);
  352.  
  353.   LineUp := true;
  354. end;
  355.  
  356. // -----------------------------------------------------------------------
  357.  
  358. procedure SoftScroll(_down: boolean);
  359.  
  360. var _pos: integer;
  361.  
  362. begin
  363.  if _down = true
  364.    then BitBlt(Form1.Canvas.Handle, 0, ChrSiz, Screen.Width,
  365.               (LinScr - 1) * ChrSiz, Form1.Canvas.Handle, 0,
  366.               ChrSiz shl 1, SRCCOPY);
  367.  
  368.  if _down = false then
  369.   for _pos := LinScr - 2 downto 1 do
  370.     if BitBlt(Form1.Canvas.Handle, 0, (_pos + 1) * ChrSiz, Screen.Width,
  371.               ChrSiz, Form1.Canvas.Handle, 0, _pos * ChrSiz,
  372.               SRCCOPY) = false then exit;
  373. end;
  374.  
  375. // -----------------------------------------------------------------------
  376.  
  377. function IdentifyFileType(_fn: string): boolean;
  378.  
  379. var _ex : string[4];
  380.     _r  : boolean;
  381.  
  382. begin
  383.   _r := true;
  384.   _ex := UpperCase(ExtractFileExt(_fn));
  385.   if _ex = SJSEXT then FFormat := 0 else
  386.     if _ex = EUCEXT then FFormat := 1 else
  387.       if _ex = JISEXT then FFormat := 2 else _r := false;
  388.   IdentifyFileType := _r;
  389. end;
  390.  
  391. // -----------------------------------------------------------------------
  392.  
  393. procedure ChkFileFormat;
  394.  
  395. begin
  396.   case Form1.OpenDlg.FilterIndex of
  397.     1: if IdentifyFileType(Form1.OpenDlg.Filename) = false
  398.          then ErrH(TXT06);
  399.     2: FFormat := 0;
  400.     3: FFormat := 1;
  401.     4: FFormat := 2;
  402.   end;
  403. end;
  404.  
  405. // -----------------------------------------------------------------------
  406.  
  407. function UseOpenDialog: string;
  408.  
  409. begin
  410.   if Form1.OpenDlg.Execute = false then Halt;
  411.   ChkFileFormat;
  412.   UseOpenDialog := Form1.OpenDlg.Filename;
  413. end;
  414.  
  415. // -----------------------------------------------------------------------
  416.  
  417. function GetFileSize(_fn: string): longint;
  418.  
  419. var _r: longint;
  420.     _f: file;
  421.  
  422. begin
  423.   if jOpenBinFile(_fn, _f) = false then ErrH(TXT00 + _fn);
  424.   _r := filesize(_f);
  425.   CloseFile(_f);
  426.   GetFileSize := _r;
  427. end;
  428.  
  429. // -----------------------------------------------------------------------
  430.  
  431. procedure InitVars1;
  432.  
  433. begin
  434.   FPos    := 0;
  435.   FLin    := 1;
  436.   ChrX    := 1;
  437.   FPages  := 0;
  438.   FLines  := 0;
  439. end;
  440.  
  441. // -----------------------------------------------------------------------
  442.  
  443. procedure TForm1.FormCreate(Sender: TObject);
  444.  
  445. begin
  446.   // Init vars
  447.   InitVars1;
  448.   FLoaded := false;
  449.  
  450.   // check char size n lines in screen
  451.   if Screen.Width < 1280 then ChrSiz := 16 else ChrSiz := 32;
  452.   ChrScr := Screen.Width  div (ChrSiz shr 1);
  453.   LinScr := Screen.Height div ChrSiz;
  454.   PrtChrScr := ChrScr;
  455.  
  456.   // init n display form
  457.   Form1.BorderStyle := bsNone;
  458.   Form1.Color  := clBlack;
  459.   Form1.Canvas.Brush.Color := clWhite;
  460.   Form1.Top    := (Screen.Height shr 1) - 30;
  461.   Form1.Left   := (Screen.Width shr 1) - 50;
  462.   Form1.Height := 60;
  463.   Form1.Width  := 100;
  464.   ShowWindow(Form1.handle, SW_SHOW);
  465.  
  466.   // init nihongo engine
  467.   if jInitialize = false then ErrH(TXT02 + #10 + paramstr(0));
  468.  
  469.   // draw 'Loading...' banner
  470.   jWriteSJS(0, 4, 32, 32, NHG00, false, false, Form1.Canvas.handle);
  471.   jWriteSJS(8, 40, 16, 16, TXT03, false, false, Form1.Canvas.handle);
  472.  
  473.   // Choose file n file format
  474.   FFormat := 0;
  475.   if paramcount = 0 then
  476.     begin
  477.       FName := UseOpenDialog
  478.     end else begin
  479.                FName := paramstr(1);
  480.                if IdentifyFileType(FName) = false then
  481.                  if (paramcount > 1) then
  482.                    begin
  483.                      if UpperCase(paramstr(2)) = USESJS
  484.                        then FFormat := 0
  485.                          else if UpperCase(paramstr(2)) = USEEUC
  486.                            then FFormat := 1
  487.                              else if UpperCase(paramstr(2)) = USEJIS
  488.                                then FFormat := 2
  489.                                  else FName := UseOpenDialog;
  490.                    end else FName := UseOpenDialog;
  491.              end;
  492.  
  493.   // draw 'Loading...' banner (yes, another time)
  494.   jWriteSJS(0, 4, 32, 32, NHG00, false, false, Form1.Canvas.handle);
  495.   jWriteSJS(8, 40, 16, 16, TXT03, false, false, Form1.Canvas.handle);
  496.  
  497.   // check file
  498.   FSize := GetFileSize(FName);
  499.   if FSize = 0 then ErrH(TXT04 + FName);
  500.  
  501.   // Load file in memory
  502.   GetMem(FData, FSize);
  503.   if jLoadFile(FName, FData) = false then ErrH(TXT01 + FName);
  504.   FLoaded := true;
  505.  
  506.   // Get only the file name
  507.   Fname := ExtractFileName(FName);
  508.  
  509.   // Init form
  510.   Form1.Top    := 0;
  511.   Form1.Left   := 0;
  512.   Form1.Width  := Screen.Width;
  513.   Form1.Height := Screen.Height;
  514.   Form1.rePaint;
  515. //  Form1.FormStyle := fsStayOnTop;
  516. end;
  517.  
  518. // -----------------------------------------------------------------------
  519.  
  520. procedure CountPages(_chrscr: word);
  521.  
  522. var _p   : pointer;
  523.     _l   : longint;
  524.     _lin : longint;
  525.     _chrsiz  : word;
  526.     _pagelin : word;
  527.  
  528. begin
  529.   _l := 0;
  530.   _p := FData;
  531.   _lin := 0;
  532.   bAbort := false;
  533.   Form1.Enabled := false;
  534.   Form2.Caption := TXT12;
  535.   Form2.Visible := true;
  536.   while (_l < FSize) and (bAbort = false) do
  537.     begin
  538.       if _lin and $08 = $08 then Application.ProcessMessages;
  539.       Form2.Caption := TXT12 + IntToStr((_l * 100) div FSize) + TXT13;
  540.       Form2.Label1.Caption := TXT15 + IntToStr(_lin);
  541.       GetCurrentLine(_p, _l, _chrScr);
  542.       inc(_lin);
  543.     end;
  544.   if bAbort = false then
  545.     begin
  546.       _chrsiz  := Printer.PageWidth div (PRTCHRSCR shr 1); {(Printer.PageWidth * 16) div 640;}
  547.       _pagelin := Printer.Pageheight div _chrsiz;
  548.       FPages   := _lin div _pagelin;
  549.       if _lin mod _pagelin <> 0 then inc(FPages);
  550.     end;
  551.   Form2.Visible := false;
  552.   Form1.Enabled := true;
  553.   Form1.SetFocus;
  554. end;
  555.  
  556. // -----------------------------------------------------------------------
  557.  
  558. procedure PrtTxt(_page, _line: longint; _plus: string);
  559.  
  560. begin
  561.   Form2.Label1.Caption := _plus + TXT07 + IntToStr(_page) + TXT08
  562.                         + IntToStr(_line);
  563. end;
  564.  
  565. // -----------------------------------------------------------------------
  566.  
  567. procedure PrintIt;
  568.  
  569. var _pos     : longint;
  570.     _line    : longint;
  571.     _page    : longint;
  572.     _point   : pointer;
  573.     _s       : string;
  574.     _chrsiz  : word;
  575.     _pagelin : word;
  576.     _xyz     : longint;
  577.  
  578.     _from    : longint;
  579.     _to      : longint;
  580.  
  581. begin
  582.   // Count pages if required
  583.   if FPages = 0 then CountPages(PRTCHRSCR);
  584.   if FPages = 0 then exit;
  585.  
  586.   // Prt Dialog
  587.   Form1.PrtDlg.MinPage := 1;
  588.   Form1.PrtDlg.MaxPage := FPages;
  589.   Form1.PrtDlg.FromPage := 1;
  590.   Form1.PrtDlg.ToPage   := FPages;
  591.   if Form1.PrtDlg.Execute = false then exit;
  592.  
  593.   // Set _copies, _from & _to
  594.   if Form1.PrtDlg.PrintRange = prPageNums then
  595.     begin
  596.       _from := Form1.PrtDlg.FromPage;
  597.       _to   := Form1.PrtDlg.ToPage;
  598.     end else begin
  599.                _from   := 1;
  600.                _to     := FPages;
  601.              end;
  602.  
  603.   // Reset Left Pos (ir required)
  604.   if ChrX <> 1 then
  605.     begin
  606.       ChrX := 1;
  607.       Form1.RePaint;
  608.     end;
  609.  
  610.   // Init some values
  611.   bAbort := false;
  612.   _pos   := 0;
  613.   _point := FData;
  614.   _page  := 1;
  615.   _chrsiz  := Printer.PageWidth div (PRTCHRSCR shr 1);
  616.   _pagelin := Printer.Pageheight div _chrsiz;
  617.   Form1.Enabled := false;
  618.   Form2.Caption := TXT11;
  619.   Form2.Visible := true;
  620.  
  621.   // Print
  622.   Printer.BeginDoc;
  623.   Printer.Canvas.Pen.Color := clBlack;
  624.   Printer.Canvas.Brush.Color := clWhite;
  625.   repeat
  626.     _line   := 1;
  627.     repeat // Print current page
  628.       Application.ProcessMessages;
  629.       if _page < _from
  630.         then PrtTxt(_page, _line, TXT16)
  631.           else PrtTxt(_page, _line, TXT17);
  632.  
  633.       _xyz := _pos;
  634.       _s   := GetCurrentLine(_point, _pos, PRTCHRSCR);
  635.       if _page >= _from then
  636.         if FFormat = 0
  637.           then jWriteSJS(0{_chrsiz shr 1}, _line * _chrSiz, _chrSiz,
  638.                          _chrSiz, _s, false, true, Printer.Canvas.handle)
  639.             else jWriteEUC(0{_chrsiz shr 1}, _line * _chrSiz, _chrSiz,
  640.                            _chrSiz, _s, false, true, Printer.Canvas.handle);
  641.       inc(_line);
  642.     until (_line = _pagelin) or (_pos = _xyz) or (bAbort = true);
  643.     if (_page >= _from) and (_page < _to) then Printer.NewPage;
  644.     inc(_page);
  645.   until (_pos = _xyz) or (bAbort = true) or (_page > _to);
  646.   if bAbort = true then Printer.Abort else Printer.EndDoc;
  647.  
  648.   // Done
  649.   Form2.Visible := false;
  650.   Form1.Enabled := true;
  651.   Form1.SetFocus;
  652. end;
  653.  
  654. // -----------------------------------------------------------------------
  655.  
  656. procedure UnloadCurrentFile;
  657.  
  658. begin
  659.   if FLoaded = true then FreeMem(FData, FSize);
  660. end;
  661.  
  662. // -----------------------------------------------------------------------
  663.  
  664. procedure OpenAnotherFile;
  665.  
  666. var _sz : longint;
  667.  
  668. begin
  669.   if Form1.OpenDlg.Execute = false then exit;
  670.   _sz := GetFileSize(Form1.OpenDlg.Filename);
  671.   if _sz = 0 then
  672.     begin
  673.       ShowMessage(TXT04 + Form1.OpenDlg.Filename);
  674.       exit;
  675.     end;
  676.   ChkFileFormat;
  677.   UnloadCurrentFile;
  678.   InitVars1;
  679.   FLoaded := false;
  680.   FName := Form1.OpenDlg.Filename;
  681.   FSize := _sz;
  682.  
  683.   // Load file in memory
  684.   GetMem(FData, FSize);
  685.   if jLoadFile(FName, FData) = false then ErrH(TXT01 + FName);
  686.   FLoaded := true;
  687.  
  688.   // Get only the file name
  689.   Fname := ExtractFileName(FName);
  690.  
  691.   // Redraw form
  692.   Form1.Repaint;
  693. end;
  694.  
  695. // -----------------------------------------------------------------------
  696.  
  697. procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  698.                              Shift: TShiftState);
  699.  
  700. var _cnt : word;
  701.     _xyz : longint;
  702.     _z   : longint;
  703.  
  704. begin
  705.   case key of
  706.     27 : Application.Terminate; // Esc
  707.     112: ShowMessage(ABOUT);    // F1
  708.     113: OpenAnotherFile;       // F2
  709.   end;
  710.  
  711.   if FLoaded = true then
  712.     case key of
  713.       32 : begin
  714.              ChrX := 1;
  715.              Form1.repaint;  // SpaceBar
  716.            end;
  717. {      8  : begin  // BackSpace
  718.              if FFormat < 2 then inc(FFormat) else FFormat := 0;
  719.              Form1.repaint;
  720.            end; }
  721.       33 : begin  // PgUp
  722.              _xyz := Fpos;
  723.              for _cnt := 3 to LinScr do LineUp;
  724.              if FPos <> _xyz then Form1.repaint else Beep;
  725.            end;
  726.       34 : begin  // PgDown
  727.              _xyz := Fpos;
  728.              for _cnt := 3 to LinScr do LineDown;
  729.              if FPos <> _xyz then Form1.repaint else Beep;
  730.            end;
  731.       38 : if LineUp = true then   // Up
  732.              begin
  733.                SoftScroll(false);
  734.                Form1.Canvas.Brush.Color := clBlack;
  735.                Form1.Canvas.Rectangle(0, ChrSiz, Width, ChrSiz shl 1);
  736.                Form1.Canvas.Brush.Color := clWhite;
  737.                DrawText(1);
  738.              end else beep;
  739.       40 : if LineDown = true then // Down
  740.              begin
  741.                SoftScroll(true);
  742.                Form1.Canvas.Brush.Color := clBlack;
  743.                Form1.Canvas.Rectangle(0, (LinScr - 1) * ChrSiz, Width,
  744.                                       Height);
  745.                Form1.Canvas.Brush.Color := clWhite;
  746.                DrawText(2);
  747.              end else beep;
  748.       37 : if (lAdjust = false) and (ChrX > 1) then // left
  749.              begin
  750.                dec(ChrX, ChrScr shr 1);
  751.                Form1.repaint;
  752.              end;
  753.       39 : if lAdjust = false then
  754.              begin // right
  755.                inc(ChrX, ChrScr shr 1);
  756.                Form1.repaint;
  757.              end;
  758.       116: begin // F5
  759.              if lAdjust = false
  760.                then lAdjust := true
  761.                  else lAdjust := false;
  762.              InitVars1;
  763. {            FLin := 1;
  764.              FPos := 0;
  765.              ChrX := 1;
  766.              FLines := 0; }
  767.              Form1.repaint;  // SpaceBar
  768.            end;
  769.       120: begin
  770.              _z := 0;
  771.              _z := StrToInt(InputBox(TXT18, TXT19, IntToStr(PrtChrScr)));
  772.              if (_z < MINCHR) or (_z > MAXCHR)
  773.                then ShowMessage(TXT20)
  774.                  else if PrtChrScr <> _z then
  775.                    begin
  776.                      FPages := 0;
  777.                      PrtChrScr := _z;
  778.                    end;
  779.            end;
  780.       119: ShowWindow(Form1.handle, SW_MINIMIZE);
  781.       121: PrintIt;               // F10
  782.      {else ShowMessage(IntToStr(key)); }
  783.     end;
  784. end;
  785.  
  786. // -----------------------------------------------------------------------
  787.  
  788. procedure TForm1.FormPaint(Sender: TObject);
  789.  
  790. begin
  791.   if FLoaded = true then DrawText(0);
  792. end;
  793.  
  794. // -----------------------------------------------------------------------
  795.  
  796. procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
  797.  
  798. begin
  799.   UnloadCurrentFile;
  800.   jClose;
  801. end;
  802.  
  803. // -----------------------------------------------------------------------
  804.  
  805. end.
  806.