Coursework Unit

The code of the coursework unit

unit Coursework;
{
    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, strutils,
  Dialogs, ComCtrls, ExtCtrls, ToolWin, StdCtrls, Menus, AppEvnts, ImgList, inifiles,
  shlobj, Gauges, Grids, Calendar, richedit;

type
  TCoursework_frm = class(TForm)
    ToolBar1: TToolBar;
    tbtn_New: TToolButton;
    tbtn_Save: TToolButton;
    Tbtn_open: TToolButton;
    tbtn_Print: TToolButton;
    ToolButton5: TToolButton;
    tbtn_Cut: TToolButton;
    tbtn_Copy: TToolButton;
    tbtn_Paste: TToolButton;
    tbtn_Undo: TToolButton;
    Tbtn_redo: TToolButton;
    ToolButton21: TToolButton;
    tbtn_Bold: TToolButton;
    tbtn_Italic: TToolButton;
    Tbtn_Underlined: TToolButton;
    ToolButton13: TToolButton;
    ComboBox1: TComboBox;
    ComboFont: TComboBox;
    ToolButton1: TToolButton;
    ColorBox1: TColorBox;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    ToolButton6: TToolButton;
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    New1: TMenuItem;
    Save1: TMenuItem;
    Save2: TMenuItem;
    SaveAs1: TMenuItem;
    Print1: TMenuItem;
    ExitProgramsavesonexit1: TMenuItem;
    Edit1: TMenuItem;
    Undo1: TMenuItem;
    Cut1: TMenuItem;
    Copy1: TMenuItem;
    Paste1: TMenuItem;
    Wordcount: TMenuItem;
    Resources1: TMenuItem;
    Generalresources1: TMenuItem;
    ProjectResources1: TMenuItem;
    Notes1: TMenuItem;
    ProjectNotes1: TMenuItem;
    ProjectNotes2: TMenuItem;
    DeadlinePlanner1: TMenuItem;
    Options1: TMenuItem;
    WritingMode1: TMenuItem;
    ImageList1: TImageList;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    PrintDialog1: TPrintDialog;
    Splitter1: TSplitter;
    Panel1: TPanel;
    RichEdit2: TRichEdit;
    Panel2: TPanel;
    RichEdit1: TRichEdit;
    Label1: TLabel;
    Richedit_menu: TPopupMenu;
    Popupundo: TMenuItem;
    N8: TMenuItem;
    PopUpCut: TMenuItem;
    PopUpCopy: TMenuItem;
    PopUpPaste: TMenuItem;
    PopUpDelete: TMenuItem;
    N1: TMenuItem;
    PopUpSelectAll: TMenuItem;
    StatusBar1: TStatusBar;
    Help1: TMenuItem;
    procedure Splitter1Moved(Sender: TObject);
    procedure tbtn_NewClick(Sender: TObject);
    procedure tbtn_SaveClick(Sender: TObject);
    procedure Tbtn_openClick(Sender: TObject);
    procedure tbtn_PrintClick(Sender: TObject);
    procedure tbtn_CutClick(Sender: TObject);
    procedure tbtn_CopyClick(Sender: TObject);
    procedure tbtn_PasteClick(Sender: TObject);
    procedure tbtn_UndoClick(Sender: TObject);
    procedure Tbtn_redoClick(Sender: TObject);
    procedure tbtn_BoldClick(Sender: TObject);
    procedure tbtn_ItalicClick(Sender: TObject);
    procedure Tbtn_UnderlinedClick(Sender: TObject);
    procedure SaveAs1Click(Sender: TObject);
    procedure ExitProgramsavesonexit1Click(Sender: TObject);
    procedure Generalresources1Click(Sender: TObject);
    procedure ProjectResources1Click(Sender: TObject);
    procedure ProjectNotes2Click(Sender: TObject);
    procedure ProjectNotes1Click(Sender: TObject);
    procedure DeadlinePlanner1Click(Sender: TObject);
    procedure Options1Click(Sender: TObject);
    procedure WritingMode1Click(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
    procedure ComboFontChange(Sender: TObject);
    procedure ColorBox1Change(Sender: TObject);
    procedure PopUpDeleteClick(Sender: TObject);
    procedure PopUpSelectAllClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure WordcountClick(Sender: TObject);
    procedure FormHide(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: boolean);
    procedure RichEdit2KeyDown(Sender: TObject; var Key: word; Shift: TShiftState);
    procedure RichEdit2MouseUp(Sender: TObject; Button: TMouseButton;
                               Shift: TShiftState; X, Y: integer);
    procedure RichEdit2SelectionChange(Sender: TObject);
    procedure RichEdit2KeyUp(Sender: TObject; var Key: word; Shift: TShiftState);
    procedure FormCreate(Sender: TObject);
    procedure RichEdit1MouseUp(Sender: TObject; Button: TMouseButton;
                               Shift: TShiftState; X, Y: integer);
    procedure Help1Click(Sender: TObject);
    procedure Richedit_menuPopup(Sender: TObject);
  private
    file_save_path: string;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Coursework_frm: TCoursework_frm;
  writing_mode, saved_before: boolean;
  tempcomp: TComponent;
  target, wordscount, Startwordcount, writingmodecount, writingmodestart,
  writingmodetarget: integer;

implementation

uses deadline_planner, options, notes, resources, main_menu;

{$R *.dfm}

procedure countwords;
var
  character_count, pointer: integer;
  strings: string;
  i: integer;
begin
  wordscount := 0;
  // Removes linebreaks, replacing them with spaces, and then trims all the excess spaces
  strings := trim(StringReplace((tempcomp as trichedit).Text, sLineBreak,
    ' ', [rfReplaceAll]));
  //Finds the length of the whole string, then minuses the length of the string minus spaces
  //then adds one to include the last word.
  pointer := 1;
  if strings <> '' then
  begin
    repeat
      if (strings[pointer] = ' ') and (strings[pointer + 1] = ' ') then
      begin
        Delete(strings, pointer, 1);
      end
      else
      begin
        Inc(pointer);
      end;
      character_count := length(strings);
    until pointer = character_count + 1;
    wordscount := length(strings) - length(StringReplace(strings, ' ', '', [rfReplaceAll])) + 1;
  end
  else
    wordscount := 0;
  if writing_mode = True then
  begin
    writingmodecount := wordscount - writingmodestart;
    coursework_frm.statusbar1.panels[1].Text := 'Writing Mode Count: ' + IntToStr(writingmodecount);
    if writingmodecount = writingmodetarget then
    begin
      coursework_frm.BorderStyle := bssizeable;
      coursework_frm.WindowState := wsnormal;
      coursework_frm.formstyle := fsnormal;
      coursework_frm.toolbar1.Show;
      coursework_frm.menu := coursework_frm.mainmenu1;
      writing_mode := not writing_mode;
    end;
  end;
  if options_frm.Progress_deadline = 2 then
    wordscount := wordscount - startwordcount;
  coursework_frm.statusbar1.panels[0].Text := format('Wordcount\Target: %s/%s', [IntToStr(wordscount), IntToStr(target)]);
end;

function BrowseDialog(const Title: string; const Flag: integer): string;
var
  lpItemID: PItemIDList;
  BrowseInfo: TBrowseInfo;
  DisplayName: array[0..MAX_PATH] of char;
  TempPath: array[0..MAX_PATH] of char;
begin
  Result := '';
  FillChar(BrowseInfo, sizeof(TBrowseInfo), #0);
  with BrowseInfo do
  begin
    hwndOwner := Application.Handle;
    pszDisplayName := @DisplayName;
    lpszTitle := PChar(Title);
    ulFlags := Flag;
  end;
  lpItemID := SHBrowseForFolder(BrowseInfo);
  if lpItemId <> nil then
  begin
    SHGetPathFromIDList(lpItemID, TempPath);
    Result := IncludeTrailingBackslash(TempPath);
    GlobalFreePtr(lpItemID);
  end;
end;

procedure Save_program();
var
  Ini: tinifile;
  myfile: textfile;
  jrgfile_path: string;
begin
  if not main_menu_frm.saved_before then
  begin
    repeat
      if not inputquery('Saving...', 'Please choose the name of the project.',
                        main_menu_frm.filename) then
        exit;
    until Main_menu_frm.filename <> '';
    jrgfile_path := BrowseDialog('Select a folder to save the shortcut file.', BIF_RETURNONLYFSDIRS);
    if jrgfile_path = '' then
      Exit;
    coursework_frm.File_save_path :=  format('%s%s\', [main_menu_frm.path, main_menu_frm.filename]);
    main_menu_frm.saved_before := True;
    // use File_save_path to get the place where ini file has to be saved to
    forcedirectories(format('%soptions\', [coursework_frm.file_save_path]));
    forcedirectories(format('%sDeadlines\', [coursework_frm.file_save_path]));
    Ini := tinifile.Create(coursework_frm.file_save_path + 'Options\Options.ini');
    ini.writeinteger('Main Section', 'Type of file', 3);
    ini.writeinteger('Main Section', 'Progress bar', 1);
  end;
  countwords;
  ini.WriteInteger('Main Section', 'Word Count', wordscount);
  // Use File_save_path to save the deadline planner and resources (notes will be on seperate form)
  // Save each tab into a new file at File_save_path
  tabname := format('%s%s', [coursework_frm.file_save_path, main_menu_frm.filename]);
  if fileexists(tabname + '_Plan.rtf') then
  begin
    if deletefile(tabname + '_Plan.rtf') then
    else
      ShowMessage('Sorry, there has been an error overwriting the plan so the program cannot save right now.');
  end;
  if fileexists(tabname + '.rtf') then
  begin
    if deletefile(tabname + '.rtf') then
    else
      ShowMessage('Sorry, there has been an error overwriting the file so the program cannot save right now.');
  end;
  Assign(myfile, format('%s\%s.jrg', [jrgfile_path, Main_menu_frm.filename]));
  rewrite(myfile);
  writeln(myfile, 'JRG file');
  closefile(myfile);
  coursework_frm.richedit2.Lines.SaveToFile(tabname + '.rtf');
  coursework_frm.RichEdit1.Lines.SaveToFile(tabname + '_Plan.rtf');
  ShowMessage('Saved program');
end;

procedure writingmode;
var
  input: string;
  Errorpos, checkint: integer;
begin
{toggles writing mode on and off, if on then the form cannot be resized, nor exited
as well as the fact that the form will stay on top}
  if not writing_mode then
  begin
    repeat
      input := inputbox('Writing Mode.',
        'How many words do you want to write in writingmode?', '1');
      val(input, checkint, errorpos);
      if not errorpos = 0 then
        ShowMessage('Please enter a valid integer number');
    until (input <> '') and (errorpos = 0);
    coursework_frm.BorderStyle := bsnone;
    coursework_frm.WindowState := wsmaximized;
    coursework_frm.formstyle := fsstayontop;
    countwords;
    Writingmodestart := wordscount;
    Writingmodecount := 0;
    writing_mode := not writing_mode;
    coursework_frm.toolbar1.hide;
    coursework_frm.menu := nil;
  end;
end;

procedure TCoursework_frm.ColorBox1Change(Sender: TObject);
begin
  (tempcomp as trichedit).SelAttributes.Color := colorbox1.selected;
  //Change font colour
end;

procedure TCoursework_frm.ComboBox1Change(Sender: TObject);
var
  Catchint, errorpos: integer;
begin
  begin
    val(combobox1.Text, catchint, errorpos);
    if (combobox1.Text <> '') and (errorpos = 0) then
    begin
      (tempcomp as trichedit).SelAttributes.Size := StrToInt(combobox1.Text);
    end
    else
    begin
      ShowMessage('Invalid input');
    end;
    //Change font type
  end;
end;

procedure TCoursework_frm.ComboFontChange(Sender: TObject);
begin
  (tempcomp as trichedit).SelAttributes.Name := ComboFont.Text;  //Change font
end;

procedure TCoursework_frm.DeadlinePlanner1Click(Sender: TObject);
begin
  if main_menu_frm.Saved_Before = True then
    deadline_planner_frm.Show
  else
    ShowMessage('You have not saved this before.');
  //Deadline Planner
end;

procedure TCoursework_frm.ExitProgramsavesonexit1Click(Sender: TObject);
begin
  halt;
end;

procedure TCoursework_frm.FormCloseQuery(Sender: TObject; var CanClose: boolean);
var
  Result: integer;
begin
  if writing_mode = True then
    CanClose := False
  else
    CanClose := True;
  //allows the user to close the form as long as writing mode isn't active
  Result := messagedlg('Are you sure you want to close this project? (Will not Save!)',
    mtConfirmation, mbyesno, 0);
  if Result = mrYes then
  else
    canclose := False;
end;

procedure TCoursework_frm.FormCreate(Sender: TObject);
begin
  combobox1.Text := '9';
  tempcomp := richedit1;//enables combofont to be filled without an error
     {The next two lines fill the combofont listbox (the one in the quickbar)
     with all the fonts that the user has installed on the computer}
  ComboFont.Items := Screen.Fonts;
  ComboFont.ItemIndex := ComboFont.Items.IndexOf((tempcomp as trichedit).Font.Name);
  coursework_frm.Caption := main_menu_frm.filename;
end;

procedure TCoursework_frm.FormHide(Sender: TObject);
begin
  richedit1.Text := '';
  (tempcomp as trichedit).Text := '';
end;

procedure TCoursework_frm.FormShow(Sender: TObject);
var
  s: string;
  Ini: tinifile;
begin
  if main_menu_frm.saved_before then
  begin
    richedit2.Lines.LoadFromFile(format('%s%s\%s.rtf',
      [Main_menu_frm.path, Main_menu_frm.filename, Main_menu_frm.filename]));
    richedit1.Lines.LoadFromFile(format('%s%s\%s_plan.rtf',
      [Main_menu_frm.path, Main_menu_frm.filename, Main_menu_frm.filename]));
    Ini := tinifile.Create(format('%s%s\Options\Options.ini',
      [main_menu_frm.path, main_menu_frm.filename]));
    target := Ini.readinteger('Main Section', 'Words', 0);
    Startwordcount := Ini.readinteger('Main Section', 'Word count', 0);
    file_save_path := main_menu_frm.path + main_menu_frm.filename + '\';
  end
  else
  begin
    repeat
      s := InputBox('New Coursework File',
        'Please choose the name of the first Part.', 'Untitled');
    until s <> '';
    coursework_frm.Caption := s;
    target := 0;
    Startwordcount := 0;
  end;
end;

procedure TCoursework_frm.Generalresources1Click(Sender: TObject);
begin
  options_frm.general_options := True;
  options_frm.Show;
  //General resources
end;

procedure TCoursework_frm.Help1Click(Sender: TObject);
begin
  main_menu_frm.Openhelpfile;
end;

procedure TCoursework_frm.Options1Click(Sender: TObject);
begin
  options_frm.general_options := False;
  options_frm.Show;
  //specific options
end;

procedure TCoursework_frm.PopUpDeleteClick(Sender: TObject);
begin
  (tempcomp as trichedit).seltext := '';
end;

procedure TCoursework_frm.PopUpSelectAllClick(Sender: TObject);
begin
  (tempcomp as trichedit).selectall;
end;

procedure TCoursework_frm.ProjectNotes1Click(Sender: TObject);
begin
  notes_frm.general_notes := True;
  notes_frm.Show;
  //general Notes
end;

procedure TCoursework_frm.ProjectNotes2Click(Sender: TObject);
begin
  notes_frm.general_notes := False;
  notes_frm.Show;
  //Project Notes
end;

procedure TCoursework_frm.ProjectResources1Click(Sender: TObject);
begin
  resources_frm.general_resources := False;
  resources_frm.Show;
  //Project resources
end;

procedure TCoursework_frm.RichEdit1MouseUp(Sender: TObject; Button: TMouseButton;
                                           Shift: TShiftState; X, Y: integer);
begin
  tempcomp := richedit1;
  if button = mbright then
  begin
    richedit_menu.popup(X + coursework_frm.Left, Y + coursework_frm.top);
  end;
end;

procedure TCoursework_frm.RichEdit2KeyDown(Sender: TObject; var Key: word;
                                           Shift: TShiftState);
begin
  if (key = 8) and ((tempcomp as trichedit).Text = '') then
  begin
    ShowMessage('Nothing to delete!');
    exit;
  end;
  richedit2selectionchange(Sender);
end;

procedure TCoursework_frm.RichEdit2KeyUp(Sender: TObject; var Key: word;
                                         Shift: TShiftState);
begin
  countwords;
end;

procedure TCoursework_frm.RichEdit2MouseUp(Sender: TObject; Button: TMouseButton;
                                           Shift: TShiftState; X, Y: integer);
begin
  tempcomp := richedit2;
  if button = mbright then
  begin
    richedit_menu.popup(X + coursework_frm.Left, Y + coursework_frm.top);
  end;
end;

procedure TCoursework_frm.RichEdit2SelectionChange(Sender: TObject);
begin
  if coursework_frm.Visible then
  begin
    coursework_frm.tbtn_bold.down := fsbold in richedit2.selattributes.style;
    coursework_frm.tbtn_italic.down := fsitalic in richedit2.selattributes.style;
    coursework_frm.tbtn_underlined.down := fsunderline in richedit2.selattributes.style;
    //checks what format the current text is, and toggles the bold, italic and
    //underline button accordingly
    coursework_frm.colorbox1.selected := richedit2.selattributes.color;
    coursework_frm.combobox1.Text := IntToStr(richedit2.SelAttributes.size);
    coursework_frm.ComboFont.ItemIndex := ComboFont.Items.IndexOf((tempcomp as TRichEdit).SelAttributes.Name);
  end;
end;

procedure TCoursework_frm.Richedit_menuPopup(Sender: TObject);
begin
  if (tempcomp as TRichEdit).seltext = '' then
  begin
    PopUpCut.Enabled := False;
    PopUpCopy.Enabled := False;
    PopUpDelete.Enabled := False;
  end
  else
  begin
    PopUpCut.Enabled := True;
    PopUpCopy.Enabled := True;
    PopUpDelete.Enabled := True;
  end;
end;

procedure TCoursework_frm.SaveAs1Click(Sender: TObject);
begin
  saved_before := False;
  save_program;
  //Save as
end;

procedure TCoursework_frm.Splitter1Moved(Sender: TObject);
begin
  panel1.Width := coursework_frm.Width - splitter1.Width - panel2.Width - 8;
  if panel2.Width <= 0 then
  begin
    splitter1.Left := 5;
    panel2.Width := 5;
  end;
end;

procedure TCoursework_frm.tbtn_BoldClick(Sender: TObject);
begin
  if fsbold in (tempcomp as trichedit).selattributes.Style then
    //toggles bold on/off for selected text; removes it if on, and adds if off
    (tempcomp as trichedit).selattributes.Style := (tempcomp as trichedit).selattributes.Style - [fsbold]
  else
    (tempcomp as trichedit).selattributes.Style := (tempcomp as trichedit).selattributes.Style + [fsbold];
end;
//bold
end;

procedure TCoursework_frm.tbtn_CopyClick(Sender: TObject);
begin
  (tempcomp as trichedit).CopyToClipboard;
  //copy
end;

procedure TCoursework_frm.tbtn_CutClick(Sender: TObject);
begin
  (tempcomp as trichedit).cuttoclipboard;
  //cut
end;

procedure TCoursework_frm.tbtn_ItalicClick(Sender: TObject);
begin
  if fsitalic in (tempcomp as trichedit).selattributes.Style then
    //toggles italic on/off for selected text; removes it if on, and adds if off
    (tempcomp as trichedit).selattributes.Style := (tempcomp as trichedit).selattributes.Style - [fsitalic]
  else
    (tempcomp as trichedit).selattributes.Style := (tempcomp as trichedit).selattributes.Style + [fsitalic];
//italic
end;

procedure TCoursework_frm.tbtn_NewClick(Sender: TObject);
var
  Result: integer;
begin
  Result := messagedlg('Are you sure you want to start a new project? (Will not save!)',
    mtConfirmation, mbyesno, 0);
  if Result = mrYes then
  begin
    (tempcomp as trichedit).Text := '';
    Richedit1.Text := '';
    main_menu_frm.Saved_Before := False;
  end;//Create new project
end;

procedure TCoursework_frm.Tbtn_openClick(Sender: TObject);
begin
  if opendialog1.Execute then
  begin
    main_menu_frm.opened_with := opendialog1.filename;
    coursework_frm.hide;
    main_menu_frm.open_file;
    main_menu_frm.Saved_Before := True;
  end;  //Open
end;

procedure TCoursework_frm.tbtn_PasteClick(Sender: TObject);
begin
  (tempcomp as trichedit).pastefromclipboard;
  //paste
end;

procedure TCoursework_frm.tbtn_PrintClick(Sender: TObject);
begin
  if (RichEdit1.SelLength <> 0) then
  begin
    PrintDialog1.PrintRange := prSelection;
  end
  else
    PrintDialog1.PrintRange := prAllPages;
  if printdialog1.Execute then
  begin
    (tempcomp as trichedit).Print(main_menu_frm.filename);
  end;
  //Print
end;

procedure TCoursework_frm.Tbtn_redoClick(Sender: TObject);
begin
  sendmessage((tempcomp as TRichEdit).handle, EM_redo, 0, 0);
  //redo
end;

procedure TCoursework_frm.tbtn_SaveClick(Sender: TObject);
begin
  save_program;//Save
end;

procedure TCoursework_frm.Tbtn_UnderlinedClick(Sender: TObject);
begin
  if fsunderline in (tempcomp as trichedit).selattributes.Style then
    //toggles underlined on/off for selected text; removes it if on, and adds if off
    (tempcomp as trichedit).selattributes.Style :=
      (tempcomp as trichedit).selattributes.Style - [fsunderline]
  else
    (tempcomp as trichedit).selattributes.Style :=
      (tempcomp as trichedit).selattributes.Style + [fsunderline];
  //Underlined
end;

procedure TCoursework_frm.tbtn_UndoClick(Sender: TObject);
begin
  (tempcomp as trichedit).Undo;
  //undo
end;

procedure TCoursework_frm.WordcountClick(Sender: TObject);
begin
  countwords;
end;

procedure TCoursework_frm.WritingMode1Click(Sender: TObject);
begin
  writingmode;
  //writing mode
end;

end.
Programming - a skill for life!

by Jerzy Griffiths: L6 Age ~17