home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 1997 May / Pcwk0597.iso / delphi / showfile.lzh / SFWSRC.ZIP / SFWU.PAS < prev   
Pascal/Delphi Source File  |  1995-07-27  |  11KB  |  406 lines
  1. unit Sfwu;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, ExtCtrls, BigText, Menus,
  8.   StdCtrls, ShellAPI, gotow, about, IniFiles;
  9.  
  10. type
  11.   TFsfw = class(TForm)
  12.     BigText1: TBigText;
  13.     Panel1: TPanel;
  14.     OpenDialog1: TOpenDialog;
  15.     FontDialog1: TFontDialog;
  16.     PrinterSetupDialog1: TPrinterSetupDialog;
  17.     FindDialog1: TFindDialog;
  18.     MainMenu1: TMainMenu;
  19.     File1: TMenuItem;
  20.     Open1: TMenuItem;
  21.     N1: TMenuItem;
  22.     Print1: TMenuItem;
  23.     SetupPrinter1: TMenuItem;
  24.     Font1: TMenuItem;
  25.     N2: TMenuItem;
  26.     Exit1: TMenuItem;
  27.     Search1: TMenuItem;
  28.     Goto1: TMenuItem;
  29.     Find1: TMenuItem;
  30.     Help1: TMenuItem;
  31.     Contents1: TMenuItem;
  32.     N3: TMenuItem;
  33.     About1: TMenuItem;
  34.     Clear1: TMenuItem;
  35.     Timer1: TTimer;
  36.     N8PointFont1: TMenuItem;
  37.     procedure FormActivate(Sender: TObject);
  38.     procedure Exit1Click(Sender: TObject);
  39.     procedure Open1Click(Sender: TObject);
  40.     procedure FormDestroy(Sender: TObject);
  41.     procedure FindDialog1Find(Sender: TObject);
  42.     procedure Find1Click(Sender: TObject);
  43.     procedure Clear1Click(Sender: TObject);
  44.     procedure FormCreate(Sender: TObject);
  45.     procedure Print1Click(Sender: TObject);
  46.     procedure SetupPrinter1Click(Sender: TObject);
  47.     procedure Font1Click(Sender: TObject);
  48.     procedure Goto1Click(Sender: TObject);
  49.     procedure About1Click(Sender: TObject);
  50.     procedure Contents1Click(Sender: TObject);
  51.     procedure Timer1Timer(Sender: TObject);
  52.     procedure N8PointFont1Click(Sender: TObject);
  53.   private
  54.     { Private declarations }
  55.     function  MenuOn: Bool;
  56.     function  MenuOff: Bool;
  57.     function  OpenFile(var filetoopen: string): bool;
  58.     procedure WMDropFiles(var msg : TMessage); message WM_DROPFILES;
  59.     function  OpenInFile(szFile : String) : Bool;
  60.   public
  61.     { Public declarations }
  62.   end;
  63.  
  64. var
  65.   Fsfw: TFsfw;
  66.   PgmTitle: String;
  67.   ANSILoad: Bool;
  68.   ANSIOn  : Bool;
  69.  
  70. implementation
  71.  
  72. {$R *.DFM}
  73.  
  74. procedure TFsfw.FormActivate(Sender: TObject);
  75. var
  76.  Ini    : TIniFile;
  77.  szFile : String;
  78. begin
  79.    if ParamCount > 0 then
  80.       begin
  81.          if ParamCount > 1 then
  82.                begin
  83.                  if UpperCase(ParamStr(1)) = '-A' then
  84.                     begin
  85.                      ANSILoad := True;
  86.                      ANSIOn   := True;
  87.                      OpenInFile(ParamStr(2));
  88.                    end;
  89.                end
  90.           else
  91.                   OpenInFile(ParamStr(1));
  92.       end
  93.    else
  94.      begin
  95.         Ini  := TIniFile.Create('sfw.ini');
  96.         with Ini do
  97.           begin
  98.             szFile :=ReadString('File', 'SFW', '');
  99.           end;
  100.         Ini.Free;
  101.         if Length(szFile) > 0 then
  102.             OpenInFile(szFile);
  103.      end;
  104. end;
  105.  
  106. procedure TFsfw.Exit1Click(Sender: TObject);
  107. begin
  108.      Application.Terminate;
  109. end;
  110.  
  111. procedure TFsfw.Open1Click(Sender: TObject);
  112. var
  113.   fname : string;
  114.   fextn : string;
  115. begin
  116.      ANSILoad := False;
  117.      if ANSIOn then
  118.         OpenDialog1.FilterIndex := 2
  119.      else
  120.         OpenDialog1.FilterIndex := 1;
  121.  
  122.      if OpenDialog1.Execute then
  123.        begin
  124.           fextn := ExtractFileExt(OpenDialog1.FileName);
  125.           if Length(Fextn) = 0 then
  126.              ANSIOn := True
  127.           else
  128.              ANSIOn := False;
  129.           if ANSIOn then
  130.              ANSILoad := True;
  131.           fname := OpenDialog1.FileName;
  132.           OpenFile(fname);
  133.        end;
  134. end;
  135.  
  136.  
  137. procedure TFsfw.FormDestroy(Sender: TObject);
  138. begin
  139.      DragAcceptFiles(Handle, False);
  140. end;
  141.  
  142. procedure TFsfw.Find1Click(Sender: TObject);
  143. begin
  144.      FindDialog1.Execute;
  145. end;
  146.  
  147. {<<<<<<<<<<<<<<<<<<<<<<<<<<< >>>>>>>>>>>>>>>>>>>>>>>>>}
  148.  
  149.  
  150. {
  151. Turn the menu on.
  152. }
  153. function TFsfw.MenuOn: Bool;
  154. begin
  155.      Panel1.Caption        := 'Ready';
  156.      clear1.enabled        := True;
  157.      Open1.enabled         := True;
  158.      SetupPrinter1.enabled := True;
  159.      Print1.enabled        := True;
  160.      Font1.enabled         := True;
  161.      Exit1.enabled         := True;
  162.      Find1.enabled         := True;
  163.      Goto1.enabled         := True;
  164.      Contents1.enabled     := True;
  165.      About1.enabled        := True;
  166.  
  167. end;
  168. {
  169. Turn the menu off
  170. }
  171. function TFsfw.MenuOff: Bool;
  172. begin
  173. {     file1.enabled := False;
  174.      search1.enabled := False;
  175.      help1.enabled := False; }
  176.      clear1.enabled        := False;
  177.      Open1.enabled         := False;
  178.      SetupPrinter1.enabled := False;
  179.      Print1.enabled        := False;
  180.      Font1.enabled         := False;
  181.      Exit1.enabled         := False;
  182.      Find1.enabled         := False;
  183.      Goto1.enabled         := False;
  184.      Contents1.enabled     := False;
  185.      About1.enabled        := False;
  186.  
  187.  
  188. end;
  189. {
  190. A normal file load from the Menu.
  191. }
  192. function TFsfw.OpenFile(var filetoopen: string): Bool;
  193. begin
  194.     Cursor         := crHourGlass;
  195.     Panel1.Caption := 'Loading: ' + filetoopen;
  196.     Application.ProcessMessages;
  197.     MenuOff;
  198.     if ANSILoad then
  199.         BigText1.LoadFromFileANSI(filetoopen)
  200.     else
  201.         BigText1.LoadFromFile(filetoopen);
  202.     MenuOn;
  203.     Cursor := crDefault;
  204.     ANSILoad := False;
  205.     Fsfw.Caption := PgmTitle + filetoopen;
  206. end;
  207.  
  208. {
  209. Function OpenInFile - String - File to open.
  210.          Returns    - Always true.
  211. Opens the given file in szFile, if the file does not exist it errors and
  212. terminates the application.  This is for command line type arguments and
  213. .INI file type arguments.  The desired behavior was to quit the application
  214. in either case when the file was not found.
  215. }
  216. function TFsfw.OpenInFile(szFile : String) : Bool;
  217. begin
  218.     Result:= True;
  219.     if FileExists(szFile) then
  220.        begin
  221.           Cursor := crHourGlass;
  222.           Panel1.Caption := 'Loading: ' + szFile + ' One Moment...';
  223.           Application.ProcessMessages;
  224.           MenuOff;
  225.           if ANSILoad then
  226.              BigText1.LoadFromFileANSI(szFile)
  227.           else
  228.              BigText1.LoadFromFile(szFile);
  229.           Panel1.Caption := 'Lines ' + Inttostr(Bigtext1.Count);
  230.           MenuOn;
  231.           Cursor := crDefault;
  232.           fsfw.Caption := PgmTitle + szFile;
  233.           ANSILoad := False;
  234.        end
  235.    else
  236.        begin
  237.           MessageDlg('File Error ' +
  238.                     szFile + CHR(13) + ' is Missing!' +
  239.                     CHR(13)+ 'Application Terminating',
  240.                     mtError, [mbOK], 0);
  241.           Application.Terminate;
  242.        end;
  243. end;
  244. {
  245. Accept Files from the File Manager
  246. Originally seen as part of Delphi & Filemngr Drag Drop
  247.            (keeper@mindsprint.com(Mark R. Johnson)
  248.            Thanks for his work.
  249. }
  250. procedure TFsfw.WMDropFiles(var msg : TMessage);
  251. var
  252.   i, n : word;
  253.   size : word;
  254.   fname : string;
  255.   hdrop : word;
  256. begin
  257.      hdrop := msg.WParam;
  258.      n := DragQueryFile(hdrop, $ffff, nil, 0);
  259.      for i:= 0 to (n - 1) do begin
  260.          size:= DragQueryFile(hdrop, i, nil, 0);
  261.          if size < 255 then begin
  262.             fname[0] := Chr(size);
  263.             DragQueryFile(hdrop, i, @fname[1], size + 1);
  264.          end;
  265.      end;
  266.      if Length(fname) > 0 then {Open only the last file }
  267.         OpenFile(fname);
  268. end;
  269.  
  270. {
  271. This procedure is used to find text in the input file.  It uses the search
  272. function of BigText.  When text is not found, it simply tells the user
  273. that it was not, otherwise, the BigText area is scrolled to the correct
  274. location and the user sees a blue line which has the text they were
  275. searching for.
  276. }
  277. procedure TFsfw.FindDialog1Find(Sender: TObject);
  278. var
  279.    ToFind  : string;
  280.    SrchDown: Bool;
  281.    MCase   : Bool;
  282. begin
  283.      ToFind := FindDialog1.FindText;
  284.      { Is search Down Checked - Default? }
  285.      if (FindDialog1.Options*[frDown])=[frDown] then
  286.         SrchDown := True
  287.      else
  288.         SrchDown := False;
  289.      { Is MatchCase Checked - Default Yes }
  290.      if (FindDialog1.Options*[frMatchCase])=[frMatchCase] then
  291.         MCase := True
  292.      else
  293.         MCase := False;
  294.  
  295.      if BigText1.Search(ToFind, SrchDown, MCase) then
  296.         begin
  297.              ToFind := '';
  298.         end
  299.      else
  300.          begin
  301.               messagedlg('Text not found', mtInformation, [mbOK], 0);
  302.          end; 
  303. end;
  304.  
  305.  
  306.  
  307. procedure TFsfw.Clear1Click(Sender: TObject);
  308. begin
  309.      fsfw.Caption := PgmTitle;
  310.      BigText1.Clear;
  311.  
  312. end;
  313.  
  314. procedure TFsfw.FormCreate(Sender: TObject);
  315. begin
  316.     if ParamCount > 0 then
  317.        WindowState := wsMaximized;
  318.      Fsfw.Paint;
  319.      application.processmessages;
  320.      DragAcceptFiles(Handle, true);
  321. end;
  322.  
  323. procedure TFsfw.Print1Click(Sender: TObject);
  324. begin
  325.      MenuOff;
  326.      Cursor := crHourGlass;
  327.      Panel1.Caption := 'Printing - One Moment...';
  328.      BigText1.Print;
  329.      MenuOn;
  330.      Cursor := crDefault;
  331. end;
  332.  
  333. procedure TFsfw.SetupPrinter1Click(Sender: TObject);
  334. begin
  335.      PrinterSetupDialog1.Execute;
  336. end;
  337.  
  338. procedure TFsfw.Font1Click(Sender: TObject);
  339. begin
  340.      if FontDialog1.Execute then
  341.         begin
  342.            BigText1.Font := FontDialog1.Font;
  343.            BigText1.Invalidate;
  344.         end;
  345. end;
  346.  
  347. procedure TFsfw.Goto1Click(Sender: TObject);
  348. var
  349.   newpos : longint;
  350. begin
  351.      Gotowin.ShowModal;
  352.      if Gotowin.gw_ok = true then
  353.      begin
  354.        if Length(gotowin.MaskEdit1.Text) > 0 then
  355.          begin
  356.           newpos := strtoint(gotowin.MaskEdit1.Text);
  357.           if newpos <> 0 then
  358.             begin
  359.               newpos := newpos - 1;
  360.               BigText1.ScrollTo(0, newpos);
  361.             end;
  362.          end;
  363.      end;
  364. end;
  365.  
  366. procedure TFsfw.About1Click(Sender: TObject);
  367. begin
  368.      AboutBox.ShowModal;
  369. end;
  370.  
  371. procedure TFsfw.Contents1Click(Sender: TObject);
  372. begin
  373.   Application.HelpFile := 'SFW.HLP';
  374.   Application.HelpCommand(HELP_CONTENTS, 0);
  375. end;
  376.  
  377. procedure TFsfw.Timer1Timer(Sender: TObject);
  378. begin
  379.      Panel1.Caption := 'Lines ' + Inttostr(Bigtext1.Count) +
  380.                    ' Cur '  + IntToStr(BigText1.CurPos + 1);
  381. end;
  382.  
  383. procedure TFsfw.N8PointFont1Click(Sender: TObject);
  384. begin
  385. {     BigText1.Font.Name         := 'Courier New';}
  386.      if N8PointFont1.Caption = 'Font Size Up' then
  387.         begin
  388.            BigText1.Font.Size   := 8;
  389.            N8PointFont1.Caption := 'Font Size Down';
  390.            N8PointFont1.ShortCut:= TextToShortCut('Ctrl+D');
  391.         end
  392.      else
  393.         begin
  394.            BigText1.Font.Size   := 7;
  395.            N8PointFont1.Caption := 'Font Size Up';
  396.            N8PointFont1.ShortCut:= TextToShortCut('Ctrl+U');
  397.         end;
  398.       BigText1.Invalidate;
  399. end;
  400.  
  401. initialization
  402.    PgmTitle := 'Show File Windows ';
  403.    ANSILoad := False;
  404.  
  405. end.
  406.