Main Menu Unit

The code of the main menu unit

unit Main_Menu;
{
    Copyright (c) 2013 Jerzy Griffiths

    Licensed under the Apache License, Version 2.0 (the "License"); you may not
    use this file except in compliance with the License, as described at
    http://www.apache.org/licenses/ and http://www.pp4s.co.uk/licenses/ }
 
interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, Inifiles, registry, strutils, ShellAPI, ShlObj;

type
  TMain_Menu_frm = class(TForm)
    New_Project_btn: TButton;
    Open_project_dialog: TOpenDialog;
    Open_Project_btn: TButton;
    Notes_btn: TButton;
    panel1: Tpanel;
    Resources_btn: TButton;
    Options_btn: TButton;
    Exit_btn: TButton;
    procedure New_Project_btnClick(Sender: TObject);
    procedure Exit_btnClick(Sender: TObject);
    procedure Open_Project_btnClick(Sender: TObject);
    procedure Notes_btnClick(Sender: TObject);
    procedure Resources_btnClick(Sender: TObject);
    procedure Options_btnClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: boolean);
  private
    Options_Ini: Tinifile;
    Type_of_File: integer;
    { Private declarations }
  public
    filename: string;
    Opened_with: string;
    Saved_Before: boolean;
    path: string;
    procedure open_file;
    procedure Openhelpfile;
    { Public declarations }
  end;

var
  Main_Menu_frm: TMain_Menu_frm;

implementation

uses File_Type, options, resources, notes, novel, coursework, playscript, general;

{$R *.dfm}
// taken from http://www.delphipages.com/forum/showthread.php?t=101767
function RegisterMyFileExtension(myext: string; myapp: string; desc: string): boolean;
begin
  with TRegistry.Create do
  begin
    RootKey := HKEY_CLASSES_ROOT;
    if OpenKey('\software\classes\.' + myext, True) then
      WriteString('', 'MyAppDataFile');
    if OpenKey('\Software\Classes\MyAppDataFile', True) then
      WriteString('', desc);
    if OpenKey('\Software\Classes\MyAppDataFile\DefaultIcon', True) then
      WriteString('', '"' + myapp + '",0');
    if OpenKey('\Software\Classes\MyAppDataFile\shell\open\command', True) then
      WriteString('', 'C:\WINDOWS\notepad.exe "%1"');
    Free;
  end;
  SHChangeNotify(SHCNE_ASSOCCHANGED, SHCNF_IDLIST, 0, 0);
end;

procedure Tmain_menu_frm.Openhelpfile;
begin
  shellExecute(0, 'open', 'explorer', PChar(main_menu_frm.path + 'helpfile.html'),
               nil, SW_SHOWNORMAL);
end;

procedure Tmain_menu_frm.Open_file;
begin
  main_menu_frm.Saved_before := True;
  main_menu_frm.filename := Extractfilename(main_menu_frm.Opened_with);
  main_menu_frm.filename := leftstr(main_menu_frm.filename,
                                    (length(main_menu_frm.filename) - 4));
  main_menu_frm.Options_ini := tinifile.Create(format('%s%s\options\options.ini',
                                               [main_menu_frm.path, main_menu_frm.filename]));
  main_menu_frm.Type_of_file := main_menu_frm.Options_ini.ReadInteger('Main Section', 'Type of File', 1);
  case main_menu_frm.type_of_file of
    1:
    begin
      Novel_frm.Caption := main_menu_frm.filename;
      novel_frm.Show;
    end;
    2:
    begin
      Playscript_frm.Show;
      playscript_frm.Caption := main_menu_frm.filename;
    end;
    3:
    begin
      coursework_frm.Show;
      coursework_frm.Caption := main_menu_frm.filename;
    end;
    4:
    begin
      general_frm.Show;
      general_frm.Caption := main_menu_frm.filename;
    end;
  end;
end;

procedure TMain_Menu_frm.Exit_btnClick(Sender: TObject);
begin
  try
    if MessageDlg('Do you really want to quit?', mtConfirmation, [mbOK, mbCancel], 0) =
      mrCancel then
    else
    begin
      if novel_frm.Visible or playscript_frm.Visible or general_frm.Visible or
        coursework_frm.Visible then
      begin
        ShowMessage('You have an application open. Please close before exiting.');
      end
      else
      begin
        novel_frm.MainMenu1.Destroy;
        Halt;
      end;
    end;
  except

  end;
end;

procedure TMain_Menu_frm.FormCloseQuery(Sender: TObject; var CanClose: boolean);
begin
  try
    if novel_frm.Visible or playscript_frm.Visible or general_frm.Visible or
      coursework_frm.Visible then
    begin
      ShowMessage('You have an application open. Please close before exiting.');
      canclose := False;
      exit;
    end;
    novel_frm.MainMenu1.Destroy;
  except

  end;
end;

procedure TMain_Menu_frm.FormShow(Sender: TObject);
begin
  filename := 'Untitled';
  open_project_dialog.filter := 'Word Processor Files|*.jrg';
  path := Format('%sWriting Program Folder\', [extractfilepath(application.ExeName)]);
  if not directoryexists(path) then
  begin
    Createdir(path);
    Createdir(path + '\General');
    Createdir(path + '\General\Options');
    Createdir(path + '\General\Resources');
  end;
  RegisterMyFileExtension('jrg', application.exename, 'Novel File');
  Opened_with := ParamStr(1);
  if opened_with <> '' then
  begin
    Open_file; //read from the options.ini file in the writing Program folder, then open up the
    //Corresponding form for the file.
  end;
end;

procedure TMain_Menu_frm.New_Project_btnClick(Sender: TObject);
begin
  Saved_before := False;
  File_type_frm.Show();
end;

procedure TMain_Menu_frm.Notes_btnClick(Sender: TObject);
begin
  notes_frm.general_notes := True;
  Notes_frm.Show();
end;

procedure TMain_Menu_frm.Open_Project_btnClick(Sender: TObject);
begin
  if Open_project_dialog.Execute() then
  begin
    Opened_with := open_project_dialog.FileName;
    Open_file;
  end;
end;

procedure TMain_Menu_frm.Options_btnClick(Sender: TObject);
begin
  Options_frm.Show;
end;

procedure TMain_Menu_frm.Resources_btnClick(Sender: TObject);
begin
  resources_frm.general_resources := True;
  Resources_frm.Show;
end;

end.
Programming - a skill for life!

by Jerzy Griffiths: L6 Age ~17