{**********************************************************
  *                    PROGRAM  WVISU.PAS                   *
  * ------------------------------------------------------- *
  * This program allows to visualize a monochrome picture   *
  * file (*.IMG) generated by other graphic programs, such  *
  * as:  billard.pas, henon.pas, rocketv2.pas etc. with a   *
  * capability of hardcopy.                                 *
  * ------------------------------------------------------- *
  * INSTRUCTIONS: Click mouse right button to clear screen. *
  *                                                         *
  *        TPW Objects English Version By J-P Moreau, Paris *
  *                      (www.jpmoreau.fr)                  *
  **********************************************************} 
  PROGRAM WVisu;     
  USES WinTypes,WinProcs,WObjects,BWCC,StdDlgs,Strings,Type_def,Savecrt,WinPrint;

  {$R WVISU.RES }      (* Resource file for menu *)
  
  TYPE 
  TVisu =OBJECT(TApplication )
    PROCEDURE InitMainWindow; virtual; 
  END;
  
  PFen =^TFen; 

  {main application window}
  TFen =OBJECT(TWindow )
    FendC :HDC;
    FenPen :HPen; 
    id_erase : BOOLEAN;
    filename : ARRAY[0..80] OF CHAR;
    CONSTRUCTOR Init (AParent :PWindowsObject; ATitle :Pchar );
    DESTRUCTOR  Done; virtual; 
    PROCEDURE Paint (PaintDC :HDC; VAR PaintInfo :TPaintStruct );virtual;
    PROCEDURE Open_file;
    PROCEDURE Print_screen;
    PROCEDURE Load_screen;
    PROCEDURE About;
    PROCEDURE Help;
    PROCEDURE Exit;
    PROCEDURE WMRButtondown (VAR Msg :TMessage );virtual 
                           wm_First +wm_RButtondown;
    PROCEDURE WMCommAND (VAR Msg :TMessage ); virtual
                           wm_First +wm_Command; 
  END;
    
  VAR
   
        P1    : TVisu;
        Pinfo : PPrinterInfo;


  {Methods of object TFen}
  CONSTRUCTOR TFen.Init; 
  BEGIN
    TWindow.init (AParent ,Atitle );
    WITH Attr DO
    BEGIN
      X :=200;Y :=200;
      W :=590;H :=500;
    END;
    MaxX:=570; MaxY:=475;
    Attr.Menu :=LoadMenu (Hinstance ,'MENU_WVISU');
    Fendc:=GetDc(HWindow);
    New(PInfo,Init);
    FenPen:=CreatePen (ps_Solid ,1,RGB (0,0,255));
    id_erase := TRUE
  END;
  
  DESTRUCTOR TFen.done; 
  BEGIN
    DeleteObject (FenPen );
    ReleaseDc(HWindow, Fendc);
    Dispose(Pinfo, Done);
    TWindow.done 
  END;

  {clear screen}
  PROCEDURE TFen.WMRButtondown; 
  BEGIN
    InvalidateRect (HWindow ,NIL ,TRUE );
    id_erase :=TRUE
  END;
  
  PROCEDURE TFen.Load_screen;
  BEGIN
    Open_file;
    WLoadCrt(Fendc, filename );
    MessageBeep (0);
    Textout (Fendc ,25,MaxY-60,'Click mouse right button or Alt-F4',34)
  END;

  {send screen to printer}
  PROCEDURE WritePDc(P:HDC;name:PChar);
  TYPE      PTab  = ^Table;
            Table = Array[0..300,0..200] of Byte;
  VAR
    T           : FILE of Table;
    I,J,L,M     : Word;
    I1,J1,marge : Word;
    finx,finy   : INTEGER;
    Noir        : LongInt;
    Pt          : Array[0..3] of PTab;
  BEGIN
    for i:=0 to 3 do New(Pt[i]);
    {IO-}
    Assign(T, name);
    Reset(T);
    {IO+}
    if IOResult<>0 then
    begin
      MessageBeep(0);
      MessageBox(P,'File not found !',
			'Warning',mb_Ok);
      exit
    end;
    Noir:=RGB(0,0,0);
    marge:=300;
    Read(T,Pt[0]^,Pt[1]^,Pt[2]^,Pt[3]^);
    Close(T);
    FOR I:=0 TO 300 DO
      FOR J:=0 TO 200 DO
        IF (Pt[0]^[I][J]=1) THEN
        BEGIN
          I1:=3*I-1; J1:=3*J-1;
          SetPixel(P,I1+marge,J1+marge,Noir);
          SetPixel(P,I1+marge+1,J1+marge,Noir);
          SetPixel(P,I1+marge+2,J1+marge,Noir);
          SetPixel(P,I1+marge,J1+marge+1,Noir);
          SetPixel(P,I1+marge+1,J1+marge+1,Noir);
          SetPixel(P,I1+marge+2,J1+marge+1,Noir);
        END;
    l:=301;
    IF MaxX < 600 THEN finx:=MaxX-21 ELSE finx:=600;
    FOR I:=l TO finx DO
      FOR J:=0 TO 200 DO
        IF (Pt[1]^[I-l][J]=1) THEN
        BEGIN
          I1:=3*I-1; J1:=3*J-1;
          SetPixel(P,I1+marge,J1+marge,Noir);
          SetPixel(P,I1+marge+1,J1+marge,Noir);
          SetPixel(P,I1+marge+2,J1+marge,Noir);
          SetPixel(P,I1+marge,J1+marge+1,Noir);
          SetPixel(P,I1+marge+1,J1+marge+1,Noir);
          SetPixel(P,I1+marge+2,J1+marge+1,Noir);
        END;
    m:=201;
    IF MaxY < 445 THEN finy:=MaxY-45 ELSE finy:=400;
    FOR I:=0 TO 300 DO
      FOR J:=m TO finy DO
        IF (Pt[2]^[I][J-m]=1) THEN
        BEGIN
          I1:=3*I-1; J1:=3*J-1;
          SetPixel(P,I1+marge,J1+marge,Noir);
          SetPixel(P,I1+marge+1,J1+marge,Noir);
          SetPixel(P,I1+marge+2,J1+marge,Noir);
          SetPixel(P,I1+marge,J1+marge+1,Noir);
          SetPixel(P,I1+marge+1,J1+marge+1,Noir);
          SetPixel(P,I1+marge+2,J1+marge+1,Noir);
        END;
    FOR I:=l TO finx DO
      FOR J:=m TO finy DO
        IF (Pt[3]^[I-l][J-m]=1) THEN
        BEGIN
          I1:=3*I-1; J1:=3*J-1;
          SetPixel(P,I1+marge,J1+marge,Noir);
          SetPixel(P,I1+marge+1,J1+marge,Noir);
          SetPixel(P,I1+marge+2,J1+marge,Noir);
          SetPixel(P,I1+marge,J1+marge+1,Noir);
          SetPixel(P,I1+marge+1,J1+marge+1,Noir);
          SetPixel(P,I1+marge+2,J1+marge+1,Noir);
        END; 
    for i:=0 to 3 do Dispose(Pt[i])
  END;

  PROCEDURE TFen.Print_screen;
  BEGIN
    with Pinfo^ do
    begin
      StartDoc('WVISU');
      WritePdc(PrintDC,filename);
      NewFrame;
      EndDoc;
      {restore screen}
      WLoadCrt(FenDC,filename);
    end
  END;

  PROCEDURE TFen.Paint; 
  BEGIN
    ReleaseDc (HWindow,FenDC);
    MaxX:=570; MaxY:=475;
    FenDC:=GetDc(HWindow);
    {restore screen if necessary}
    if (strlen(filename)<>0) and (Not id_erase) then
      WLoadCrt(FenDC,filename);
    id_erase:=FALSE
  END;
  
  PROCEDURE TFen.Open_file;
  BEGIN
    Application^.ExecDialog (NEW (PFileDialog ,Init (@self ,
    Pchar (sd_FileOpen ),StrCopy (filename ,'*.IMG'))));
  END;

  PROCEDURE TFen.About;
  BEGIN
    MessageBox(HWinDOw,'Author: J-P Moreau Version 1.2','WVISU',
                          mb_Ok OR mb_IconExclamation);
  END;

  PROCEDURE TFen.Help;
  BEGIN
    TextOut(FenDC,10,10,'INSTRUCTIONS:',13);
    TextOut(FenDC,10,40,'File/Open : Open a dialog box to choose picture file to load',60);
    TextOut(FenDC,10,60,'File/Print : Send loaded picture to current printer         ',60);
    TextOut(FenDC,10,80,'File/Quit : Exit program with confirmation box              ',60);
    TextOut(FenDC,10,120,'Click on mouse right button to clear screen.                ',60);
  END;

  PROCEDURE TFen.Exit; {Exit program}
  VAR ok :INTEGER; 
  BEGIN
    MessageBeep (0);
    ok :=MessageBox (HWindow ,'Click on OK to confirm exit.',
    'End program',mb_OkCancel );
    IF  ok =id_Ok  THEN CloseWindow 
  END;
  
  PROCEDURE TFen.WMCommand; 
  BEGIN
    IF  Msg.LparamLo =0 THEN 
    CASE Msg.WParam OF 
    101:Load_screen;
    102:Print_screen;
    103:Exit;
    201:Help;
    202:About;
    ELSE TFEn.wmCommAND (Msg );exit; 
    end
    ELSE TFen.wmCommAND (Msg );
  END;
  
  PROCEDURE TVisu.InitMainWindow;
  BEGIN
    MainWindow :=New (PFen ,Init (NIL ,'VIEW A PICTURE FILE *.IMG'));
  END;
  
  BEGIN 
    P1.init ('');
    P1.run; 
    P1.done 
  END. 
  
{end of file wvisu.pas


Resource file wvisu.rc for program menu

MENU_WVISU MENU
BEGIN
	POPUP "Files"
	BEGIN
		MENUITEM "Open", 101
		MENUITEM "Print", 102
		MENUITEM SEPARATOR
		MENUITEM "Quit", 103
	END

	POPUP "?"
	BEGIN
		MENUITEM "Help", 201
		MENUITEM "About...", 202
	END

END

}