General Unit

The code of the general unit

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

type
  TGeneral_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;
    Text_Size_combo: TComboBox;
    ComboFont: TComboBox;
    ToolButton1: TToolButton;
    ColorBox1: TColorBox;
    ToolButton3: TToolButton;
    ToolButton6: TToolButton;
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    New: TMenuItem;
    Open: TMenuItem;
    Save: TMenuItem;
    SaveAs: TMenuItem;
    Print: TMenuItem;
    ExitProgramsavesonexit: TMenuItem;
    Edit1: TMenuItem;
    Undo: TMenuItem;
    Cut: TMenuItem;
    Copy: TMenuItem;
    Paste: TMenuItem;
    Word_count: TMenuItem;
    Options: TMenuItem;
    ImageList1: TImageList;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    PrintDialog1: TPrintDialog;
    RichEdit1: TRichEdit;
    Richedit_menu: TPopupMenu;
    Popupundo: TMenuItem;
    N8: TMenuItem;
    PopUpCut: TMenuItem;
    PopUpCopy: TMenuItem;
    PopUpPaste: TMenuItem;
    PopUpDelete: TMenuItem;
    N1: TMenuItem;
    PopUpSelectAll: TMenuItem;
    Words: TToolButton;
    Help1: TMenuItem;
    procedure RichEdit1SelectionChange(Sender: TObject);
    procedure tbtn_BoldClick(Sender: TObject);
    procedure tbtn_ItalicClick(Sender: TObject);
    procedure Tbtn_UnderlinedClick(Sender: TObject);
    procedure tbtn_UndoClick(Sender: TObject);
    procedure tbtn_NewClick(Sender: TObject);
    procedure Tbtn_redoClick(Sender: TObject);
    procedure tbtn_PasteClick(Sender: TObject);
    procedure tbtn_CopyClick(Sender: TObject);
    procedure tbtn_PrintClick(Sender: TObject);
    procedure ExitProgramsavesonexitClick(Sender: TObject);
    procedure UndoClick(Sender: TObject);
    procedure CutClick(Sender: TObject);
    procedure CopyClick(Sender: TObject);
    procedure OptionsClick(Sender: TObject);
    procedure NewClick(Sender: TObject);
    procedure PasteClick(Sender: TObject);
    procedure Tbtn_openClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ToolButton6Click(Sender: TObject);
    procedure tbtn_SaveClick(Sender: TObject);
    procedure Word_countClick(Sender: TObject);
    procedure PopUpDeleteClick(Sender: TObject);
    procedure PopUpSelectAllClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormHide(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: boolean);
    procedure RichEdit1KeyDown(Sender: TObject; var Key: word; Shift: TShiftState);
    procedure RichEdit1KeyUp(Sender: TObject; var Key: word; Shift: TShiftState);
    procedure RichEdit1MouseUp(Sender: TObject; Button: TMouseButton;
                               Shift: TShiftState; X, Y: integer);
    procedure SaveAsClick(Sender: TObject);
    procedure ComboFontChange(Sender: TObject);
    procedure ColorBox1Change(Sender: TObject);
    procedure Text_Size_comboChange(Sender: TObject);
    procedure Help1Click(Sender: TObject);
    procedure Richedit_menuPopup(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  General_frm: TGeneral_frm;
  To_save: boolean;

implementation

uses main_menu;

{$R *.dfm}

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 TGeneral_frm.UndoClick(Sender: TObject);
begin
  richedit1.undo;
end;

procedure TGeneral_frm.Word_countClick(Sender: TObject);
var
  strings: string;
  countword, pointer, character_count: integer;
begin
  // Removes linebreaks, replacing them with spaces, and then trims all the excess spaces
  strings := trim(StringReplace(richedit1.Text, sLineBreak, ' ', [rfReplaceAll]));
  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;
    countword := length(strings) -
      length(StringReplace(strings, ' ', '', [rfReplaceAll])) + 1;
  end
  else
    countword := 0;
  //Finds the length of the whole string, then minuses the length of the string minus spaces
  //then adds one to include the last word.
  //if Length(Strings) = 0 then countword:=0;
  if Sender = word_count then
    ShowMessage('There are ' + IntToStr(countword) + ' words.');
  words.Caption := 'Words: ' + IntToStr(countword);
end;

procedure TGeneral_frm.ColorBox1Change(Sender: TObject);
begin
  richedit1.SelAttributes.Color := ColorBox1.selected;
end;

procedure TGeneral_frm.ComboFontChange(Sender: TObject);
begin
  richedit1.SelAttributes.Name := ComboFont.Text;
end;

procedure TGeneral_frm.CopyClick(Sender: TObject);
begin
  richedit1.CopyToClipboard;
end;

procedure TGeneral_frm.CutClick(Sender: TObject);
begin
  richedit1.CutToClipboard;
end;

procedure TGeneral_frm.ExitProgramsavesonexitClick(Sender: TObject);
begin
  halt;
end;

procedure TGeneral_frm.FormCloseQuery(Sender: TObject; var CanClose: boolean);
var
  Result: integer;
begin
  Result := messagedlg('Are you sure you want to quit? (Will not save!)', mtConfirmation, mbyesno, 0);
  if Result = mrYes then
  else
    canclose := False;
end;

procedure TGeneral_frm.FormCreate(Sender: TObject);
begin
  with OpenDialog1 do
    Options := Options + [ofAllowMultiSelect, ofFileMustExist];
  OpenDialog1.Filter := 'Word Processor Files (*.JRG)|*.JRG|All files (*.*)|*.*';
  Text_size_combo.Text := '9';
  ComboFont.Items := Screen.Fonts;
  ComboFont.ItemIndex := ComboFont.Items.IndexOf(richedit1.Font.Name);
  general_frm.Caption := main_menu_frm.filename;
end;

procedure TGeneral_frm.FormHide(Sender: TObject);
begin
  richedit1.Text := '';
end;

procedure TGeneral_frm.FormShow(Sender: TObject);
var
  s: string;
begin
  //Load file if opened from main menu
  if main_menu_frm.saved_before then
  begin
    richedit1.Lines.LoadFromFile(format('%s%s.rtf', [Main_menu_frm.path, Main_menu_frm.filename]));
  end
  else
  begin
    repeat
      s := InputBox('New General File', 'What would you like to call the project?', 'Untitled');
    until s <> '';
    general_frm.Caption := s;
  end;
end;

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

procedure TGeneral_frm.NewClick(Sender: TObject);
var
  Result: integer;
begin
  Result := messagedlg('Would you like to save your project before exiting?',
                       mtConfirmation, mbyesno, 0);
  if not Result = mrNo then
  begin
    richedit1.Lines.SaveToFile(SaveDialog1.FileName);
    richedit1.Text := '';
  end;
end;

procedure TGeneral_frm.OptionsClick(Sender: TObject);
begin
  options_frm.Show;
end;

procedure TGeneral_frm.PasteClick(Sender: TObject);
begin
  richedit1.PasteFromClipboard;
end;

procedure TGeneral_frm.PopUpDeleteClick(Sender: TObject);
begin
  richedit1.seltext := '';
end;

procedure TGeneral_frm.PopUpSelectAllClick(Sender: TObject);
begin
  richedit1.SelectAll;
end;

procedure TGeneral_frm.RichEdit1KeyDown(Sender: TObject; var Key: word;
  Shift: TShiftState);
begin
  if (key = 8) and (richedit1.Text = '') then
  begin
    ShowMessage('Nothing to delete!');
    exit;
  end;
  Richedit1Selectionchange(Sender);
end;

procedure TGeneral_frm.RichEdit1KeyUp(Sender: TObject; var Key: word; Shift: TShiftState);
begin
  Word_countClick(Sender);
end;

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

procedure TGeneral_frm.RichEdit1SelectionChange(Sender: TObject);
begin
  if general_frm.Visible then
  begin
    general_frm.tbtn_bold.down := fsbold in richedit1.selattributes.style;
    general_frm.tbtn_italic.down := fsitalic in richedit1.selattributes.style;
    general_frm.tbtn_underlined.down := fsunderline in richedit1.selattributes.style;
    //checks what format the current text is, and toggles the bold, italic and
    //underline button accordingly
    general_frm.colorbox1.selected := richedit1.selattributes.color;
    general_frm.Text_size_combo.Text := IntToStr(richedit1.SelAttributes.size);
    general_frm.ComboFont.Text := richedit1.SelAttributes.Name;
  end;
end;

procedure TGeneral_frm.Richedit_menuPopup(Sender: TObject);
begin
  if richedit1.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 TGeneral_frm.SaveAsClick(Sender: TObject);
begin
  main_menu_frm.saved_before := False;
  tbtn_saveclick(Sender);
end;

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

procedure TGeneral_frm.tbtn_CopyClick(Sender: TObject);
begin
  richedit1.copytoclipboard;
end;

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

procedure TGeneral_frm.tbtn_NewClick(Sender: TObject);
var
  Result: integer;
  Input: string;
begin
  Result := messagedlg('Are you sure you want to start a new project? (Will not save!)',
                       mtConfirmation, mbyesno, 0);
  if Result = mrYes then
  begin
    richedit1.Text := '';
    main_menu_frm.Saved_Before := False;
  end;
end;

procedure TGeneral_frm.Tbtn_openClick(Sender: TObject);
var
  filename: string;
begin
  if opendialog1.Execute() then
  begin
    //richedit1.Lines.LoadFromFile(OpenDialog1.filename);
    main_menu_frm.opened_with := OpenDialog1.filename;
    general_frm.Hide;
    main_menu_frm.open_file;
  end;
end;

procedure TGeneral_frm.tbtn_PasteClick(Sender: TObject);
begin
  richedit1.PasteFromClipboard;
end;

procedure TGeneral_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
    richedit1.Print(main_menu_frm.filename);
  end;
end;

procedure TGeneral_frm.Tbtn_redoClick(Sender: TObject);
begin
  sendmessage(RichEdit1.handle, EM_redo, 0, 0);
end;

procedure saving;
var
  Result: integer;
  myfile: textfile;
  jrgfile_path: string;
  ini: tinifile;
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;
    // use File_save_path to get the place where ini file has to be saved to
    forcedirectories(Main_menu_frm.path + main_menu_frm.filename + '\options\');
    Ini := tinifile.Create(Main_menu_frm.path + main_menu_frm.filename +
                           '\options\Options.ini');
    ini.writeinteger('Main Section', 'Type of file', 4);
    Assign(myfile, format('%s%s.jrg', [jrgfile_path, main_menu_frm.filename]));
    rewrite(myfile);
    writeln(myfile, 'JRG file');
    closefile(myfile);
  end;
  General_frm.Caption := main_menu_frm.filename;
  if fileexists(Main_menu_frm.path + main_menu_frm.filename + '.rtf') then
  begin
    if deletefile(Main_menu_frm.path + main_menu_frm.filename + '.rtf') then
    else
      ShowMessage('Sorry, the program cannot be saved right yet');
  end;
  general_frm.richedit1.Lines.SaveToFile(Main_menu_frm.path +
                                         main_menu_frm.filename + '.rtf');
  ShowMessage('Program saved');
end;

procedure TGeneral_frm.tbtn_SaveClick(Sender: TObject);
begin
  saving;
end;

procedure TGeneral_frm.Tbtn_UnderlinedClick(Sender: TObject);
begin
  if fsunderline in richedit1.selattributes.Style then
    //toggles bold on/off for selected text; removes it if on, and adds if off
    richedit1.selattributes.Style := richedit1.selattributes.Style - [fsunderline]
  else
    richedit1.selattributes.Style := richedit1.selattributes.Style + [fsunderline];
end;

procedure TGeneral_frm.tbtn_UndoClick(Sender: TObject);
begin
  richedit1.undo;
end;

procedure TGeneral_frm.Text_Size_comboChange(Sender: TObject);
var
  Catchint, Errorpos: integer;
begin
  try
    val(Text_Size_combo.Text, Catchint, Errorpos);
    if (Text_Size_combo.Text <> '') and (Errorpos = 0) then
    begin
      richedit1.SelAttributes.Size :=
        StrToInt(Text_Size_combo.Text);
    end
    else
    begin
      ShowMessage('Invalid input');
    end;
  finally
  end;
end;

procedure TGeneral_frm.ToolButton6Click(Sender: TObject);
begin
  options_frm.Show;
end;

end.
Programming - a skill for life!

by Jerzy Griffiths: L6 Age ~17