home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 19 / CD_ASCQ_19_010295.iso / dos / prg / pas / ktools / source / swagread.pas < prev    next >
Pascal/Delphi Source File  |  1994-11-17  |  8KB  |  329 lines
  1. Program SwagRead;
  2. { lecture de fichiers SWAG; utilisation de l'objet TSwagFile et des
  3.   unités de fenêtrage }
  4. { KB mai-juin 1994 }
  5.  
  6. {.$DEFINE debug}
  7.  
  8. {$IFDEF debug}
  9.  {$A+,B-,D+,E-,F-,I+,L+,N-,R+,S+,V-,W+,X+}
  10. {$ELSE}
  11.  {$A+,B-,D-,E-,F-,I+,L-,N-,R-,S-,V-,W+,X+}
  12. {$ENDIF}
  13.  
  14. Uses Dos,
  15.      UMem,UDrivers,
  16.      OTableau,OFSwag,
  17.      OGenView,OTxtView,ODialWin,OHelpWin;
  18.  
  19. Const
  20.  cmInit=$200;
  21.  cmAbout=$201;
  22.  cmHelp=$202;
  23.  
  24. Type
  25.  PSwagSelWin=^TSwagSelWin;
  26.  TSwagSelWin=object(TSelWin)
  27.   SwagFile:PSwagFile;
  28.   Constructor Init(SwagFileName:PathStr);
  29.   Destructor Done; virtual;
  30.   Function GetErrorMsg:String; virtual;
  31.   Function NombreItems:Integer; virtual;
  32.   Function Ligne(n:Integer):String; virtual;
  33.   Procedure HandleEvent(Var Event:TEvent); virtual;
  34.   end;
  35.  
  36.  PSwagTextWin=^TSwagTextWin;
  37.  TSwagTextWin=object(TWindow)
  38.   Data : PStrTab;
  39.   L1,C1:Integer;
  40.   Constructor Init(f:PSwagFile;num:Integer);
  41.   Destructor Done;virtual;
  42.   Procedure DrawInterior;virtual;
  43.   Procedure Bouger(dx,dy:Integer);
  44.   Procedure HandleEvent(Var Event:TEvent);virtual;
  45.   End;
  46.  
  47.  PSwagApp=^TSwagApp;
  48.  TSwagApp=object(TTextApp)
  49.   Constructor Init;
  50.   Procedure InitStatusLine;virtual;
  51.   Procedure MakeSelWin(SwagFileName:PathStr);
  52.   Procedure HandleEvent(Var Event:TEvent);virtual;
  53.   End;
  54.  
  55. Var MonApp:PSwagApp;
  56.  
  57. { objet TSwagSelWin }
  58.  
  59. Constructor TSwagSelWin.Init(SwagFileName:PathStr);
  60. Var D:DirStr;
  61.     N:NameStr;
  62.     E:NameStr;
  63. Begin
  64.  FSplit(SwagFileName,D,N,E);
  65.  TSelWin.Init(1,2,27,20,N+E);
  66.  SwagFile:=New(PSwagFile,Init(SwagFileName));
  67.  Ident:='SWAGSEL';
  68.  PalOffSet:=pCyan;
  69.  if not SwagFile^.IsValid
  70.     then ErrorFlag:=erInitFile;
  71. End;
  72.  
  73. Destructor TSwagSelWin.Done;
  74. Begin
  75.  dispose(SwagFile,Done);
  76.  TSelWin.Done;
  77. End;
  78.  
  79. Function TSwagSelWin.GetErrorMsg:String;
  80. Begin
  81.  if ErrorFlag=erInitFile
  82.     then GetErrorMsg:=SwagFile^.GetErrorMsg
  83.     else GetErrorMsg:=TSelWin.GetErrorMsg;
  84. End;
  85.  
  86. Function TSwagSelWin.NombreItems:Integer;
  87. Begin
  88.  NombreItems:=SwagFile^.MsgTab.NombreItems;
  89. End;
  90.  
  91. Function TSwagSelWin.Ligne(n:Integer):String;
  92. Var S:String;
  93.     MR:TMsgRec;
  94. Begin
  95.  if (n<1) or (n>NombreItems)
  96.     then S:=''
  97.     else begin
  98.           SwagFile^.MsgTab.Lire(MR,n);
  99.           S:=MR.Sujet;
  100.          end;
  101.  Ligne:=S;
  102. End;
  103.  
  104. Procedure TSwagSelWin.HandleEvent(Var Event:TEvent);
  105. Var E:TEvent;
  106.     W:PSwagTextWin;
  107. Begin
  108.  TSelWin.HandleEvent(Event);
  109.  if ExitCode=exOk
  110.     then begin
  111.           ExitCode:=0;
  112.           W:=New(PSwagTextWin,Init(SwagFile,Choix));
  113.           if not W^.IsValid
  114.              then begin
  115.                    Message(W^.GetErrorMsg);
  116.                    dispose(W,Done);
  117.                   end
  118.              else begin
  119.                    Application^.Insert(W);
  120.                    W^.Show;
  121.                   end;
  122.          end;
  123. End;
  124.  
  125. { objet TSwagTextWin }
  126.  
  127. Constructor TSwagTextWin.Init(f:PSwagFile;num:Integer);
  128. Var MR:TMsgRec;
  129. Begin
  130.  TWindow.Init(1,2,78,21,'');
  131.  Ident:='SWAGTEXT';
  132.  L1:=1;
  133.  C1:=1;
  134.  f^.MsgTab.Lire(MR,num);
  135.  Titre:=MR.Sujet;
  136.  while Titre[length(Titre)]=' ' do dec(Titre[0]);
  137.  Titre:=' '+Titre+' ';
  138.  Data:=f^.ReadMsg(num);
  139. End;
  140.  
  141. Destructor TSwagTextWin.Done;
  142. Begin
  143.  if Data<>nil
  144.     then dispose(Data,Done);
  145.  TWindow.Done;
  146. End;
  147.  
  148. Procedure TSwagTextWin.DrawInterior;
  149. Var S:String;
  150.     i:Byte;
  151. Begin
  152.  For i:=1 to Hauteur do
  153.   begin
  154.    if L1+i-1>Data^.NombreItems
  155.       then S:=''
  156.       else S:=Data^.Ligne(L1+i-1);
  157.    if C1>1
  158.       then if length(S)>C1
  159.               then begin
  160.                     move(S[C1],S[1],length(S)-C1+1);
  161.                     S[0]:=chr(length(S)-C1+1);
  162.                    end
  163.               else S:='';
  164.    Ajuste(S,largeur);
  165.    Ecrire(S,1,i,0);
  166.   end;
  167. End;
  168.  
  169. Procedure TSwagTextWin.Bouger(dx,dy:Integer);
  170. Begin
  171.  C1:=C1+dx;
  172.  if C1<1
  173.     then C1:=1
  174.     else if C1>255
  175.             then C1:=255;
  176.  L1:=L1+dy;
  177.  if L1<1
  178.     then L1:=1
  179.     else if L1>Data^.NombreItems
  180.             then L1:=Data^.NombreItems;
  181. End;
  182.  
  183. Procedure TSwagTextWin.HandleEvent(Var Event:TEvent);
  184. Begin
  185.  TWindow.HandleEvent(Event);
  186.  case Event.What of
  187.   evMouseAuto:
  188.    begin
  189.     if Event.LButton and SurCadre(Event.Where)
  190.        then begin
  191.              if Event.Where.Y>Origin.Y+hauteur div 2
  192.                 then Bouger(0,1)
  193.                 else Bouger(0,-1);
  194.             end
  195.        else exit;
  196.    end;
  197.   evKeyDown:
  198.    case Event.KeyCode of
  199.      CsUp: Bouger(0,-1);
  200.      PgUp: Bouger(0,-Hauteur);
  201.      CsDn: Bouger(0,1);
  202.      PgDn: Bouger(0,Hauteur);
  203.      CPgUp: L1:=1;
  204.      CPgDn: L1:=Data^.NombreItems-Hauteur;
  205.      CsLf: Bouger(-1,0);
  206.      CsRg: Bouger(1,0);
  207.      Home: C1:=1;
  208.      else exit;
  209.     end;
  210.   else exit;
  211.   end;
  212.  Event.What:=evNothing;
  213.  DrawInterior;
  214. End;
  215.  
  216. { objet TSwagApp }
  217.  
  218. Constructor TSwagApp.Init;
  219. Begin
  220.  TTextApp.Init;
  221.  Titre:='Visualisateur de fichiers SWAG (K.B. 1994)';
  222.  if paramcount>0
  223.     then SetCommand(cmInit);
  224. End;
  225.  
  226. Procedure TSwagApp.InitStatusLine;
  227. Begin
  228.  TTextApp.InitStatusLine;
  229.  StatusLine^.AjouterItem('F1 Aide',F1);
  230.  StatusLine^.AjouterItem('F2 Fichier',F2);
  231.  StatusLine^.AjouterItem('AltX Quitter',AltX);
  232. End;
  233.  
  234. Procedure TSwagApp.MakeSelWin(SwagFileName:PathStr);
  235. Var SelWin : PSwagSelWin;
  236. Begin
  237.  if SwagFileName=''
  238.     then exit;
  239.  Patience('Chargement en cours ...');
  240.  SelWin:=New(PSWagSelWin,Init(SwagFileName));
  241.  FinPatience;
  242.  if SelWin^.IsValid
  243.     then begin
  244.           Insert(SelWin);
  245.           SelWin^.Show;
  246.          end
  247.     else begin
  248.           Message(SelWin^.GetErrorMsg);
  249.           dispose(SelWin,Done);
  250.          end;
  251. End;
  252.  
  253. Procedure TSwagApp.HandleEvent(Var Event:TEvent);
  254. Var S:String;
  255.     H:PHelpWin;
  256.     CurWin:PGenView;
  257. Begin
  258.  TTextApp.HandleEvent(Event);
  259.  case Event.What of
  260.   evCommand:
  261.    case Event.Command of
  262.     cmInit: MakeSelWin(ParamStr(1));
  263.     cmAbout:
  264.      Message(chr(13)+
  265.              '          S W A G R E A D          '+chr(13)+
  266.              '          Kostrzewa Bruno          '+chr(13)+
  267.              '          (novembre 1994)          '+chr(13));
  268.     cmHelp:
  269.      begin
  270.       H:=New(PHelpWin,Init(AppPath+'SWAGREAD.HLP'));
  271.       if not H^.IsValid
  272.          then Message(H^.GetErrorMsg)
  273.          else begin
  274.                H^.Ident:='AIDE';
  275.                Insert(H);
  276.                H^.Exec;
  277.               end;
  278.       dispose(H,Done);
  279.      end;
  280.     else exit;
  281.     end;
  282.   evKeyDown:
  283.    case Event.KeyCode of
  284.     AltS:
  285.      begin
  286.       CurWin:=FindSelect;
  287.       if (CurWin<>nil) and (CurWin^.Ident='SWAGTEXT')
  288.              then begin
  289.                    WinRead(S,' Sauver sous ');
  290.                    if S<>''
  291.                       then begin
  292.                             Patience('Sauvegarde en cours...');
  293.                             PSwagTextWin(CurWin)^.Data^.Save(S);
  294.                             FinPatience;
  295.                            end;
  296.                   end
  297.              else Message('Rien à sauver ! ');
  298.      end;
  299.     F1: SetCommand(cmHelp);
  300.     F2: begin
  301.          S:=GetFile('*.SWG');
  302.          if S<>''
  303.             then begin
  304.                   ClearDeskTop;
  305.                   MakeSelWin(S);
  306.                  end;
  307.         end;
  308.     F3: SetCommand(cmAbout);
  309.     else exit;
  310.    end;
  311.   else exit;
  312.  end;
  313.  Event.What:=evNothing;
  314. End;
  315.  
  316. BEGIN
  317.  {$ifdef debug}
  318.  initmem;
  319.  {$endif}
  320.  MonApp:=New(PSwagApp,Init);
  321.  MonApp^.Exec;
  322.  dispose(MonApp,Done);
  323.  {$ifdef debug}
  324.  diagmem;
  325.  {$endif}
  326. END.
  327.  
  328. {                        Fin du fichier SWAGREAD.PAS                        }
  329.