home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 1998 April A / Pcwk4a98.iso / PROGRAM / DELPHI16 / Format / MAIN.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-06-10  |  11.3 KB  |  388 lines
  1. unit Main;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, StdCtrls, Buttons, ExtCtrls, Menus, About, Register,
  8.   Status, BDisk, FileCtrl, Graflite;
  9.  
  10. type
  11.   TSFXFormat = class(TForm)
  12.     MainMenu: TMainMenu;
  13.     DisketteSize: TComboBox;
  14.     Label1: TLabel;
  15.     GroupBox1: TGroupBox;
  16.     VerifyCheckBox: TCheckBox;
  17.     VolumeLabelEdit: TEdit;
  18.     Label2: TLabel;
  19.     AboutBtn: TBitBtn;
  20.     CancelBtn: TBitBtn;
  21.     Label3: TLabel;
  22.     FileMenu: TMenuItem;
  23.     ExitItem: TMenuItem;
  24.     FormatItem: TMenuItem;
  25.     HelpMenu: TMenuItem;
  26.     AboutItem: TMenuItem;
  27.     DriveComboBox1: TDriveComboBox;
  28.     GraphicLight1: TGraphicLight;
  29.     GraphicLight2: TGraphicLight;
  30.     SOTBtn: TBitBtn;
  31.     HelpBtn: TBitBtn;
  32.     FormatBtn: TBitBtn;
  33.     N2: TMenuItem;
  34.     procedure SetWinTitle;
  35.     procedure RepeatFormat;
  36.     procedure FormatIt;
  37.     procedure FileExit(Sender: TObject);
  38.     procedure HelpAbout(Sender: TObject);
  39.     procedure FormatItemClick(Sender: TObject);
  40.     procedure ExitItemClick(Sender: TObject);
  41.     procedure CancelBtnClick(Sender: TObject);
  42.     procedure AboutItemClick(Sender: TObject);
  43.     procedure FormatBtnClick(Sender: TObject);
  44.     procedure AboutBtnClick(Sender: TObject);
  45.     procedure FormCreate(Sender: TObject);
  46.     procedure Format2Click(Sender: TObject);
  47.     procedure SOTBtnClick(Sender: TObject);
  48.     procedure HelpBtnClick(Sender: TObject);
  49.     procedure N2Click(Sender: TObject);
  50.     private
  51.        DNum: Byte;             {Drive Number}
  52.        DTyp: Char;             {Drive Type 0..4}
  53.        Verify: Boolean;        {Verify ?}
  54.        VStr: VolumeStr;        {Volume String}
  55.        SOT: Boolean;           {Keep form on top?}
  56.   end;
  57.  
  58. var
  59.   SFXFormat: TSFXFormat;
  60.  
  61. implementation
  62.  
  63. {$R *.DFM}
  64.  
  65. {-required function for Format}
  66. function AbortFunc (Track, MaxTrack : Byte; Kind : Byte) : Boolean; far;
  67. var
  68. Msg: string;
  69. EndMessage: string;
  70. Percent: Integer;  {Percent Complete}
  71. const
  72. NewLine = #10#13;
  73. {-Send status to status form}
  74.  begin  {AbortFunc}
  75.    case Kind of
  76.      0 : begin
  77.             {set graphiclites}
  78.             SFXFormat.GraphicLight2.ActiveLight := AlGray;{Format beginning}
  79.             SFXFormat.GraphicLight1.DarkLite := True;
  80.             SFXFormat.GraphicLight1.ActiveLight := AlRed;
  81.          end;
  82.      1 : {Formatting track}
  83.          begin
  84.             if StatusForm.ModalResult <> mrCancel then
  85.             begin
  86.                  Msg := 'Formatting track ';
  87.                  Msg := Msg + IntToStr(Track);
  88.                  {Set label text in status form}
  89.                  StatusForm.Label2.Caption := Msg;
  90.                  Percent := (Track*100) div MaxTrack;
  91.                  {Draw status bar with ratio value}
  92.                  StatusForm.Gauge1.Progress := Percent;
  93.                  {Process windows messages - permit detection of cancel button}
  94.                  Application.ProcessMessages;
  95.             end;
  96.             if StatusForm.ModalResult = mrCancel then
  97.             begin
  98.                  StatusForm.Hide;
  99.                  {set graphiclites}
  100.                  SFXFormat.GraphicLight1.DarkLite := False;
  101.                  SFXFormat.GraphicLight1.ActiveLight := AlGreen;
  102.                  SFXFormat.GraphicLight2.ActiveLight := AlGray;
  103.                  MessageDlg('Formatting has been cancelled!!', mtWarning, [mbOk], 0);
  104.                  exit;
  105.             end;
  106.          end;
  107.      2 : {Verifying track}
  108.          begin
  109.             Msg := 'Verifying track... ';
  110.             Msg := Msg + IntToStr(Track);
  111.             {Set static text in statusform}
  112.             StatusForm.Label1.Caption := Msg;
  113.          end;
  114.      3 : {Writing boot, FAT and VOLUME Label}
  115.          begin
  116.             {Set static text in statusform}
  117.             Msg := 'Writing boot, FAT and Volume Label';
  118.             StatusForm.Label1.Caption := Msg;
  119.          end;
  120.      4 : {Format ending}
  121.          begin
  122.          {Track returns final status code in this case}
  123.          if Track = 0 then
  124.          {}
  125.          else
  126.          begin
  127.          {Finished with error, get rid of progress dialog}
  128.           if StatusForm.ModalResult <> mrCancel then begin
  129.           {set graphiclites}
  130.           SFXFormat.GraphicLight1.DarkLite := True;
  131.           SFXFormat.GraphicLight1.ActiveLight := AlRed;
  132.           SFXFormat.GraphicLight2.ActiveLight := AlGray;
  133.           EndMessage := 'Disk drive is not ready.' + NewLine;
  134.           EndMessage := EndMessage + 'Be sure to select the correct disk size!' + NewLine + NewLine;
  135.           EndMessage := EndMessage + 'Place a diskette in drive and try again!';
  136.           MessageDlg(EndMessage, mtError, [mbOk], 0);
  137.           end;
  138.           end;
  139.        end;
  140.    end;
  141.    AbortFunc := False;
  142. end;
  143.  
  144. procedure TSFXFormat.SetWinTitle;
  145. var
  146. WinTitle: string;
  147. begin
  148.    WinTitle := 'Formatting '+ DisketteSize.Text + ' Floppy Disk';
  149.    StatusForm.Caption := WinTitle;
  150. end;
  151.  
  152. {-repeat formatting method}
  153. procedure TSFXFormat.RepeatFormat;
  154. begin
  155.    FormatIt;
  156. end;
  157.  
  158. {-format diskette}
  159. procedure TSFXFormat.FormatIt;
  160. var
  161. Msg: string;
  162. VerifyStr: string;
  163. EndMsg: string;
  164. WinMsg: string;
  165. Again: Integer;
  166. begin
  167.  
  168.    {Set window tile of progress meter};
  169.    SetWinTitle;
  170.    {Make and show status messages}
  171.    if VerifyCheckBox.State = cbChecked then
  172.    begin
  173.       VerifyStr := 'Verify is on';
  174.       Verify := True;
  175.    end
  176.    else
  177.    begin
  178.       VerifyStr := 'Verify is off';
  179.       Verify := False;
  180.    end;
  181.    StatusForm.Label1.Caption := VerifyStr;
  182.    Msg := 'Formatting...';
  183.    {Set static text in statusform}
  184.    StatusForm.Label2.Caption := Msg;
  185.    StatusForm.ModalResult := mrNone;
  186.    {Show the status Form}
  187.    StatusForm.Show;
  188.    {Format the disk}
  189.              FormatDisk (DNum,                    {drive number}
  190.                          Byte(DTyp)-Byte('0'),    {format type}
  191.                          Verify,                  {verify?}
  192.                          0,                       {max bad sectors, 0 -> no limit}
  193.                          VStr,                    {volume label}
  194.                          AbortFunc);              {abort function}
  195.     StatusForm.Close;
  196.     {set graphiclites}
  197.     GraphicLight1.DarkLite := False;
  198.     GraphicLight1.ActiveLight := AlGreen;
  199.     GraphicLight1.ActiveLight := AlGray;
  200.     EndMsg := 'Do you want to format another disk?';
  201.     Again := MessageDlg(EndMsg, mtConfirmation, [mbYes, mbNo], 0);
  202.     if Again = mrYes then begin
  203.     GraphicLight1.ActiveLight := AlGray;
  204.     GraphicLight2.DarkLite := True;
  205.     GraphicLight2.ActiveLight := AlRed;
  206.     WinMsg := 'Place the disk to be formatted into drive '+
  207.     DriveComboBox1.Drive + ' and select &Ok to format the diskette.';
  208.     if MessageDlg(WinMsg, mtConfirmation, [mbOk, mbCancel], 0) = mrOk then FormatIt else
  209.      begin
  210.         {set graphiclites}
  211.         GraphicLight1.DarkLite := False;
  212.         GraphicLight1.ActiveLight := AlGray;
  213.         GraphicLight2.DarkLite := True;
  214.         GraphicLight2.ActiveLight := AlRed;
  215.         RepeatFormat;
  216.      end;
  217.     end;
  218.     {set graphiclites}
  219.     GraphicLight1.DarkLite := False;
  220.     GraphicLight1.ActiveLight := AlGreen;
  221.     GraphicLight2.DarkLite := False;
  222.     GraphicLight2.ActiveLight := AlGray;
  223.  end;
  224.  
  225. procedure TSFXFormat.FileExit(Sender: TObject);
  226. begin
  227.   Close;
  228. end;
  229.  
  230. procedure TSFXFormat.HelpAbout(Sender: TObject);
  231. begin
  232.   { Add code to show program's About Box }
  233.   AboutBox.ShowModal;
  234. end;
  235.  
  236. procedure TSFXFormat.FormatItemClick(Sender: TObject);
  237. begin
  238.      FormatBtnClick(Sender); 
  239. end;
  240.  
  241. procedure TSFXFormat.ExitItemClick(Sender: TObject);
  242. begin
  243.      Close;
  244. end;
  245.  
  246. procedure TSFXFormat.CancelBtnClick(Sender: TObject);
  247. begin
  248.      Close;
  249. end;
  250.  
  251. procedure TSFXFormat.AboutItemClick(Sender: TObject);
  252. begin
  253.      AboutBox.ShowModal;
  254. end;
  255.  
  256. procedure TSFXFormat.FormatBtnClick(Sender: TObject);
  257. var
  258. Msg: string;
  259. WinMsg: string;
  260. const
  261. NewLine = #10#13;
  262. begin {Format}
  263.    {only format drive A or B}
  264.    if DriveComboBox1.Drive <> 'A' then
  265.       if DriveComboBox1.Drive <> 'B' then
  266.    begin
  267.       MessageDlg('Sorry, This program will only format floppy drives!',
  268.       mtWarning, [mbOk], 0);
  269.       {set graphiclites}
  270.       GraphicLight1.DarkLite := False;
  271.       GraphicLight1.ActiveLight := AlGreen;
  272.       GraphicLight2.DarkLite := False;
  273.       GraphicLight2.ActiveLight := AlGray;
  274.       exit;
  275.    end;
  276.    {set graphiclites}
  277.    GraphicLight1.DarkLite := True;
  278.    GraphicLight1.ActiveLight := AlRed;
  279.    GraphicLight2.DarkLite := False;
  280.    GraphicLight2.ActiveLight := AlGray;
  281.  
  282.    {if A Drive then set drive number 0}
  283.    if DriveComboBox1.Drive = 'A' then
  284.       DNum := 0;
  285.  
  286.    {if B Drive then set drive number 1}
  287.    if DriveComboBox1.Drive = 'B' then
  288.       DNum := 1;
  289.  
  290.    {if 360k then set DriveType = 1}
  291.    if DisketteSize.Text = '360 kb' then
  292.       DTyp := '1';
  293.  
  294.    {if 720k then set DriveType = 2}
  295.    if DisketteSize.Text = '720 kb' then
  296.       DTyp := '3';
  297.  
  298.    {if 1.2M then set DriveType = 3}
  299.    if DisketteSize.Text = '1.2 mb' then
  300.       DTyp := '2';
  301.  
  302.    {if 1.44M then set DriveType = 4}
  303.    if DisketteSize.Text = '1.44 mb' then
  304.       DTyp := '4';
  305.  
  306.    {add volume label string to message}
  307.    Msg := 'The diskette volume label is ';
  308.    if Length(VolumeLabelEdit.Text) > 0 then Msg := Msg + VolumeLabelEdit.Text +
  309.       '.' else Msg := 'The diskette does not have a volume label.';
  310.    {Convert the array to a pascal string}
  311.    VStr := VolumeLabelEdit.Text;
  312.    {Add a new line}
  313.    Msg := Msg + NewLine;
  314.    {Get verify status and set boolean variable}
  315.    if VerifyCheckBox.State = cbChecked then
  316.    begin
  317.       WinMsg := 'Formatting verification is on.';
  318.       Verify := True;
  319.    end
  320.    else
  321.    begin
  322.       WinMsg := 'Formatting verification is off.';
  323.       Verify := False;
  324.    end;
  325.    WinMsg := WinMsg + NewLine + Msg;
  326.    {Add two lines}
  327.    WinMsg := WinMsg + NewLine;
  328.    WinMsg := WinMsg + 'Place the disk to be formatted into drive ';
  329.    WinMsg := WinMsg + DriveComboBox1.Drive + ' and select &Ok to format the diskette.';
  330.    if MessageDlg(WinMsg, mtConfirmation, [mbOk, mbCancel], 0) = mrOk then FormatIt else
  331.      begin
  332.         {set graphiclites}
  333.         GraphicLight1.DarkLite := False;
  334.         GraphicLight1.ActiveLight := AlGreen;
  335.         GraphicLight2.DarkLite := False;
  336.         GraphicLight2.ActiveLight := AlGray;
  337.      end;
  338. end;
  339.  
  340. procedure TSFXFormat.AboutBtnClick(Sender: TObject);
  341. begin
  342.      if FormStyle = fsStayOnTop then AboutBox.FormStyle := fsStayOnTop;
  343.      AboutBox.ShowModal;
  344. end;
  345.  
  346. procedure TSFXFormat.FormCreate(Sender: TObject);
  347. begin
  348.      DriveComboBox1.Drive := 'A';
  349.      DisketteSize.Text := '1.44 mb';
  350.      SOT := True;
  351. end;
  352.  
  353. procedure TSFXFormat.Format2Click(Sender: TObject);
  354. begin
  355.      FormatBtnClick(Sender);
  356. end;
  357.  
  358.  
  359. procedure TSFXFormat.SOTBtnClick(Sender: TObject);
  360. begin
  361. if SOT then
  362.    begin
  363.       SFXFormat.FormStyle := fsNormal;
  364.       SOTBtn.Caption := 'StayOnTop';
  365.       SOT := False;
  366.    end
  367.    else
  368.    begin
  369.       SFXFormat.FormStyle := fsStayOnTop;
  370.       SOTBtn.Caption := 'Normal';
  371.       SOT := True;
  372.    end;
  373. end;
  374.  
  375. procedure TSFXFormat.HelpBtnClick(Sender: TObject);
  376. begin
  377.    Application.HelpFile := 'FORMAT.HLP';
  378.    Application.HelpCommand(HELP_CONTENTS,0);
  379. end;
  380.  
  381. procedure TSFXFormat.N2Click(Sender: TObject);
  382. begin
  383.    Application.HelpFile := 'FORMAT.HLP';
  384.    Application.HelpCommand(HELP_CONTENTS,0);
  385. end;
  386.  
  387. end.
  388.