Mega Code Archive

 
Categories / Delphi / Examples
 

A Simple Notepad with Delphi 6

Title: A Simple Notepad with Delphi 6 Question: A Simple Notepad with Delphi (though reinventing the wheel) Answer: Its been quite a long time since I wrote my last article. Recently I just developed a simple notepad, though with some bugs and limitations, with Delphi 6 Enterprise Trial Edition. I just would like to share the code with our community and help to improve further. It might look like reinventing the wheel; but I just wanted to develop some products like this with Delphi. The first thing that striked my mind is this Notepad All the functions available in the normal notepad will be available with this and also I have added two more things in the Options menu (Want Tabs and Want Returns); by default, its been checked. And you can change the background color of the notepad, though you cannot save. Some functions like find text, replace have to be revisited though. If you people have any ideas on that, please feel free to share/update the code. The following is the entire code: --------------------------------------------- Project Code: DelphiNotepad.dpr --------------------------------------------- program DelphiNotepad; uses Forms, NotePad1 in 'NotePad1.pas' {Form1}, GoToForm in 'GoToForm.pas' {frmGoTo}; {$R *.res} begin Application.Initialize; Application.Title := 'Delphi Notepad'; Application.CreateForm(TForm1, Form1); Application.CreateForm(TfrmGoTo, frmGoTo); Application.Run; end. ----------------------------------------- Unit One Code: Notepad1.pas ----------------------------------------- unit NotePad1; { Unit Name : NotePad1.pas Developed By : S S B Magesh Puvananthiran Description : A simple notepad developed with Delphi 6 } interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls,ConvUtils, Menus, ComCtrls,StrUtils, ExtDlgs ; type TForm1 = class(TForm) Memo1: TMemo; MainMenu1: TMainMenu; FileMenu: TMenuItem; FileNew: TMenuItem; FileOpen: TMenuItem; EditMenu: TMenuItem; Undo: TMenuItem; N1: TMenuItem; Cut: TMenuItem; Copy: TMenuItem; Paste: TMenuItem; SelectAll1: TMenuItem; FormatMenu: TMenuItem; WordWrap: TMenuItem; FileSave: TMenuItem; Exit2: TMenuItem; FileExit: TMenuItem; SelectAll: TMenuItem; Font: TMenuItem; HelpMenu: TMenuItem; AboutNotepad: TMenuItem; TimeDate: TMenuItem; OpenDialog1: TOpenDialog; SaveDialog1: TSaveDialog; StatusBar1: TStatusBar; FontDialog1: TFontDialog; SaveAs1: TMenuItem; FilePrint: TMenuItem; N2: TMenuItem; PrintDialog1: TPrintDialog; PrinterSetupDialog1: TPrinterSetupDialog; FindDialog1: TFindDialog; N3: TMenuItem; Find: TMenuItem; FindNext: TMenuItem; Replace: TMenuItem; GoTo1: TMenuItem; ReplaceDialog1: TReplaceDialog; BackgroundColor: TMenuItem; ColorDialog1: TColorDialog; Options1: TMenuItem; WantTabs1: TMenuItem; WantReturns1: TMenuItem; procedure FileExitClick(Sender: TObject); procedure AboutNotepadClick(Sender: TObject); procedure FileOpenClick(Sender: TObject); procedure FileSaveClick(Sender: TObject); procedure FileNewClick(Sender: TObject); procedure WordWrapClick(Sender: TObject); procedure FontClick(Sender: TObject); procedure UndoClick(Sender: TObject); procedure CutClick(Sender: TObject); procedure CopyClick(Sender: TObject); procedure PasteClick(Sender: TObject); procedure SelectAllClick(Sender: TObject); procedure TimeDateClick(Sender: TObject); procedure Memo1Change(Sender: TObject); procedure Memo1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure Memo1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); procedure FormCreate(Sender: TObject); procedure SaveAs1Click(Sender: TObject); procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); procedure FilePrintClick(Sender: TObject); procedure PageSetupClick(Sender: TObject); procedure FindDialog1Find(Sender: TObject); procedure FindClick(Sender: TObject); procedure FindNextClick(Sender: TObject); procedure ReplaceClick(Sender: TObject); procedure ReplaceDialog1Replace(Sender: TObject); procedure ReplaceDialog1Find(Sender: TObject); procedure GoTo1Click(Sender: TObject); procedure BackgroundColorClick(Sender: TObject); procedure WantTabs1Click(Sender: TObject); procedure WantReturns1Click(Sender: TObject); private procedure OpenTheFile; function SaveChanges : Boolean; { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation uses GoToForm; {$R *.dfm} procedure TForm1.AboutNotepadClick(Sender: TObject); begin ShowMessage(' Delphi Notepad ' + #13 + ' Developed with Borland Delphi 6 Enterprise Trial Edition'); end; procedure TForm1.FileExitClick(Sender: TObject); begin Close; end; procedure TForm1.FileOpenClick(Sender: TObject); begin if not(Memo1.Modified)then OpenTheFile else if (Memo1.Modified) then begin ModalResult := MessageDlg('Save Changes?',mtConfirmation,[mbYes,mbNo,mbCancel],0); if ((ModalResult = mrYes) and (SaveChanges)) or (ModalResult = mrNo) then begin OpenTheFile; Memo1.Modified := False; end; end; end; procedure TForm1.FileSaveClick(Sender: TObject); begin if SaveChanges then Memo1.Modified := False; end; procedure TForm1.FileNewClick(Sender: TObject); begin if not(Memo1.Modified) then begin Memo1.Clear; Form1.Caption := 'UnNamed - Delphi Notepad'; OpenDialog1.FileName := ''; SaveDialog1.FileName := ''; end else if (Memo1.Modified) then begin ModalResult := MessageDlg('Save Changes?',mtConfirmation,[mbYes,mbNo,mbCancel],0); if (ModalResult = mrYes) and (SaveChanges) then begin Memo1.Clear; Form1.Caption := 'UnNamed - Delphi Notepad'; Memo1.Modified := False; OpenDialog1.FileName := ''; SaveDialog1.FileName := ''; end else if ModalResult = mrNo then begin Memo1.Clear; Form1.Caption := 'UnNamed - Delphi Notepad'; OpenDialog1.FileName := ''; SaveDialog1.FileName := ''; Memo1.Modified := False; end; end; end; procedure TForm1.OpenTheFile; begin if OpenDialog1.Execute then begin Memo1.Lines.LoadFromFile(OpenDialog1.FileName); Form1.Caption := OpenDialog1.FileName + ' - ' + 'Delphi Notepad'; end; end; function TForm1.SaveChanges : Boolean; begin Result := False; if (OpenDialog1.FileName = '') and (SaveDialog1.FileName = '') then begin if SaveDialog1.Execute then begin Screen.Cursor := crHourGlass; StatusBar1.SimpleText := 'Saving...'; Memo1.Lines.SaveToFile(SaveDialog1.FileName); Form1.Caption := SaveDialog1.FileName + ' - ' + 'Delphi Notepad'; StatusBar1.SimpleText := 'Ready'; Screen.Cursor := crDefault; Result := True; end; end else begin Screen.Cursor := crHourGlass; StatusBar1.SimpleText := 'Saving...'; if OpenDialog1.FileName '' then begin Memo1.Lines.SaveToFile(OpenDialog1.FileName); Form1.Caption := OpenDialog1.FileName + ' - ' + 'Delphi Notepad'; end else if SaveDialog1.FileName '' then begin Memo1.Lines.SaveToFile(SaveDialog1.FileName); Form1.Caption := SaveDialog1.FileName + ' - ' + 'Delphi Notepad'; end; StatusBar1.SimpleText := 'Ready'; Screen.Cursor := crDefault; Result := True; end; end; procedure TForm1.WordWrapClick(Sender: TObject); begin if WordWrap.Checked then begin Memo1.WordWrap := True; Memo1.ScrollBars := ssVertical; end else begin Memo1.WordWrap := False; Memo1.ScrollBars := ssBoth; end; end; procedure TForm1.FontClick(Sender: TObject); begin if FontDialog1.Execute then begin Memo1.Font := FontDialog1.Font; Memo1.Font.Color := FontDialog1.Font.Color; end; end; procedure TForm1.UndoClick(Sender: TObject); begin if (Memo1.Modified) and (Memo1.CanUndo) then Memo1.Undo; end; procedure TForm1.CutClick(Sender: TObject); begin Memo1.CutToClipboard; end; procedure TForm1.CopyClick(Sender: TObject); begin Memo1.CopyToClipboard; end; procedure TForm1.PasteClick(Sender: TObject); begin Memo1.PasteFromClipboard; end; procedure TForm1.SelectAllClick(Sender: TObject); begin Memo1.SelectAll; end; procedure TForm1.TimeDateClick(Sender: TObject); begin Memo1.SelText := DateToStr(Now) + TimeToStr(Time); end; procedure TForm1.Memo1Change(Sender: TObject); begin if (Memo1.Modified) and (Memo1.CanUndo) then Undo.Enabled := True else Undo.Enabled := False; end; procedure TForm1.Memo1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if Memo1.SelText '' then begin Cut.Enabled := True; Copy.Enabled := True; end else begin Cut.Enabled := False; Copy.Enabled := False; end; end; procedure TForm1.Memo1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); begin if Memo1.SelText '' then begin Cut.Enabled := True; Copy.Enabled := True; end else begin Cut.Enabled := False; Copy.Enabled := False; end; end; procedure TForm1.FormCreate(Sender: TObject); begin Form1.Caption := 'UnNamed - Delphi Notepad'; end; procedure TForm1.SaveAs1Click(Sender: TObject); begin if SaveDialog1.Execute then begin Memo1.Lines.SaveToFile(SaveDialog1.FileName); Form1.Caption := SaveDialog1.FileName + ' - Delphi Notepad'; Memo1.Clear; Memo1.Lines.LoadFromFile(SaveDialog1.FileName); end; end; procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean); begin if (Memo1.Modified) then begin ModalResult := MessageDlg('Save Changes?',mtConfirmation,[mbYes,mbNo,mbCancel],0); if ((ModalResult = mrYes) and (SaveChanges)) or (ModalResult = mrNo) then CanClose := True else CanClose := False; end else if not(Memo1.Modified) then CanClose := True; end; procedure TForm1.FilePrintClick(Sender: TObject); begin if PrintDialog1.Execute then Print else PrinterSetupDialog1.Execute; end; procedure TForm1.PageSetupClick(Sender: TObject); begin PrinterSetupDialog1.Execute; end; procedure TForm1.FindDialog1Find(Sender: TObject); var I, J, PosReturn, SkipChars: Integer; CursorPos : TPoint; begin CursorPos := Memo1.CaretPos; if frDown in FindDialog1.Options then begin for I := CursorPos.Y + 1 to Memo1.Lines.Count do begin PosReturn := Pos(FindDialog1.FindText,Memo1.Lines[I]); if (PosReturn 0) then begin SkipChars := 0; for J := 0 to I - 1 do SkipChars := SkipChars + Length(Memo1.Lines[J]); SkipChars := SkipChars + (I*2); SkipChars := SkipChars + PosReturn - 1; Memo1.SelStart := SkipChars; Memo1.SelLength := Length(FindDialog1.FindText); Break; end; end; end else begin for I := CursorPos.Y - 1 downto 0 do begin PosReturn := Pos(FindDialog1.FindText,Memo1.Lines[I]); if PosReturn 0 then begin SkipChars := 0; for J := 0 to I - 1 do SkipChars := SkipChars + Length(Memo1.Lines[J]); SkipChars := SkipChars + (I*2); SkipChars := SkipChars + PosReturn - 1; Memo1.SelStart := SkipChars; Memo1.SelLength := Length(FindDialog1.FindText); Break; end; end; end; end; procedure TForm1.FindClick(Sender: TObject); begin FindDialog1.Execute; end; procedure TForm1.FindNextClick(Sender: TObject); begin FindDialog1Find(nil); end; procedure TForm1.ReplaceClick(Sender: TObject); begin ReplaceDialog1.Execute; end; procedure TForm1.ReplaceDialog1Replace(Sender: TObject); var CursorPos : TPoint; I, J, SkipChars, PosReturn : integer; begin if frReplace in ReplaceDialog1.Options then Memo1.SelText := ReplaceDialog1.ReplaceText else if frReplaceAll in ReplaceDialog1.Options then begin CursorPos := Memo1.CaretPos; for I := CursorPos.Y + 1 to Memo1.Lines.Count do begin PosReturn := Pos(ReplaceDialog1.FindText,Memo1.Lines[I]); if PosReturn 0 then begin SkipChars := 0; for J := 0 to I - 1 do SkipChars := SkipChars + Length(Memo1.Lines[J]); SkipChars := SkipChars + (I*2); SkipChars := SkipChars + PosReturn - 1; Memo1.SelStart := SkipChars; Memo1.SelLength := Length(ReplaceDialog1.FindText); Memo1.SelText := ReplaceDialog1.ReplaceText; end; end; end; end; procedure TForm1.ReplaceDialog1Find(Sender: TObject); var I, J, PosReturn, SkipChars: Integer; CursorPos : TPoint; begin CursorPos := Memo1.CaretPos; for I := CursorPos.Y + 1 to Memo1.Lines.Count do begin PosReturn := Pos(ReplaceDialog1.FindText,Memo1.Lines[I]); if PosReturn 0 then begin SkipChars := 0; for J := 0 to I - 1 do SkipChars := SkipChars + Length(Memo1.Lines[J]); SkipChars := SkipChars + (I*2); SkipChars := SkipChars + PosReturn - 1; Memo1.SelStart := SkipChars; Memo1.SelLength := Length(ReplaceDialog1.FindText); Break; end; end; end; procedure TForm1.GoTo1Click(Sender: TObject); begin frmGoTo.ShowModal; end; procedure TForm1.BackgroundColorClick(Sender: TObject); begin if ColorDialog1.Execute then Memo1.Color := ColorDialog1.Color; end; procedure TForm1.WantTabs1Click(Sender: TObject); begin if WantTabs1.Checked then Memo1.WantTabs := True else Memo1.WantTabs := False; end; procedure TForm1.WantReturns1Click(Sender: TObject); begin if WantReturns1.Checked then Memo1.WantReturns := True else Memo1.WantReturns := False; end; end. ----------------------------------------------- Unit One Form File : Notepad1.dfm ----------------------------------------------- object Form1: TForm1 Left = 160 Top = 107 Width = 579 Height = 414 ActiveControl = Memo1 Caption = 'Delphi Notepad' Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'MS Sans Serif' Font.Style = [] Menu = MainMenu1 OldCreateOrder = False Position = poScreenCenter OnCloseQuery = FormCloseQuery OnCreate = FormCreate PixelsPerInch = 96 TextHeight = 13 object Memo1: TMemo Left = 0 Top = 0 Width = 571 Height = 349 Align = alClient BevelInner = bvNone Color = clWhite HideSelection = False ScrollBars = ssBoth TabOrder = 0 WantTabs = True WordWrap = False OnChange = Memo1Change OnKeyUp = Memo1KeyUp OnMouseUp = Memo1MouseUp end object StatusBar1: TStatusBar Left = 0 Top = 349 Width = 571 Height = 19 Panels = SimplePanel = True SimpleText = 'Ready' end object MainMenu1: TMainMenu Left = 256 Top = 176 object FileMenu: TMenuItem Caption = '&File' object FileNew: TMenuItem Caption = '&New' ShortCut = 16462 OnClick = FileNewClick end object FileOpen: TMenuItem Caption = '&Open...' ShortCut = 16463 OnClick = FileOpenClick end object FileSave: TMenuItem Caption = '&Save' ShortCut = 16467 OnClick = FileSaveClick end object SaveAs1: TMenuItem Caption = 'Save &As...' OnClick = SaveAs1Click end object Exit2: TMenuItem Caption = '-' end object FilePrint: TMenuItem Caption = '&Print...' ShortCut = 16464 OnClick = FilePrintClick end object N2: TMenuItem Caption = '-' end object FileExit: TMenuItem Caption = 'E&xit' OnClick = FileExitClick end end object EditMenu: TMenuItem Caption = '&Edit' object Undo: TMenuItem Caption = '&Undo' Enabled = False ShortCut = 16474 OnClick = UndoClick end object N1: TMenuItem Caption = '-' end object Cut: TMenuItem Caption = 'C&ut' Enabled = False ShortCut = 16472 OnClick = CutClick end object Copy: TMenuItem Caption = '&Copy' Enabled = False ShortCut = 16451 OnClick = CopyClick end object Paste: TMenuItem Caption = '&Paste' ShortCut = 16470 OnClick = PasteClick end object SelectAll1: TMenuItem Caption = '-' end object Find: TMenuItem Caption = '&Find...' ShortCut = 16454 OnClick = FindClick end object FindNext: TMenuItem Caption = 'Find &Next...' ShortCut = 114 OnClick = FindNextClick end object Replace: TMenuItem Caption = '&Replace' ShortCut = 16456 OnClick = ReplaceClick end object GoTo1: TMenuItem Caption = '&Go To...' ShortCut = 16455 OnClick = GoTo1Click end object N3: TMenuItem Caption = '-' end object SelectAll: TMenuItem Caption = 'Select &All' ShortCut = 16449 OnClick = SelectAllClick end object TimeDate: TMenuItem Caption = 'Time/Date' ShortCut = 116 OnClick = TimeDateClick end end object Options1: TMenuItem Caption = '&Options' object WantTabs1: TMenuItem AutoCheck = True Caption = '&Want Tabs' Checked = True OnClick = WantTabs1Click end object WantReturns1: TMenuItem AutoCheck = True Caption = 'Want &Returns' Checked = True OnClick = WantReturns1Click end end object FormatMenu: TMenuItem Caption = '&Format' object WordWrap: TMenuItem AutoCheck = True Caption = '&WordWrap' OnClick = WordWrapClick end object Font: TMenuItem Caption = '&Font...' OnClick = FontClick end object BackgroundColor: TMenuItem Caption = '&Background Color...' OnClick = BackgroundColorClick end end object HelpMenu: TMenuItem Caption = '&Help' object AboutNotepad: TMenuItem Caption = '&About Delphi Notepad' OnClick = AboutNotepadClick end end end object OpenDialog1: TOpenDialog DefaultExt = '*.txt' Filter = 'Text Files|*.txt|All Files|*.*' InitialDir = 'C:\MyDocuments' Title = 'Open File...' Left = 328 Top = 192 end object SaveDialog1: TSaveDialog DefaultExt = '*.txt' Filter = 'Text Files|*.txt|All Files|*.*' InitialDir = 'C:\' Options = [ofOverwritePrompt, ofHideReadOnly, ofEnableSizing] Title = 'Save File...' Left = 312 Top = 136 end object FontDialog1: TFontDialog Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'MS Sans Serif' Font.Style = [] MinFontSize = 0 MaxFontSize = 0 Left = 272 Top = 192 end object PrintDialog1: TPrintDialog Options = [poPrintToFile, poPageNums, poSelection, poWarning, poHelp, poDisablePrintToFile] Left = 272 Top = 192 end object PrinterSetupDialog1: TPrinterSetupDialog Left = 216 Top = 72 end object FindDialog1: TFindDialog Options = [frDisableMatchCase, frDisableWholeWord] OnFind = FindDialog1Find Left = 152 Top = 192 end object ReplaceDialog1: TReplaceDialog Options = [frDisableMatchCase, frDisableWholeWord] OnFind = ReplaceDialog1Find OnReplace = ReplaceDialog1Replace Left = 272 Top = 192 end object ColorDialog1: TColorDialog Ctl3D = True Left = 240 Top = 224 end end ------------------------------------------- Unit Two Code: GoToForm.pas ------------------------------------------- unit GoToForm; { Unit Name : GoToForm.pas Developed By : S S B Magesh Puvananthiran Description : A simple form to enter the line number. } interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Buttons; type TfrmGoTo = class(TForm) Edit1: TEdit; BitBtn1: TBitBtn; BitBtn2: TBitBtn; procedure BitBtn1Click(Sender: TObject); procedure FormShow(Sender: TObject); private { Private declarations } public { Public declarations } end; var frmGoTo: TfrmGoTo; implementation uses NotePad1; {$R *.dfm} procedure TfrmGoTo.BitBtn1Click(Sender: TObject); var LineNum, PosReturn, i, SkipChars : integer; begin try PosReturn := 0; LineNum := StrToInt(Edit1.Text) - 1; if (LineNum = 1) and (LineNum + 1 begin SkipChars := 0; for i := 0 to LineNum - 1 do begin SkipChars := SkipChars + Length(Form1.Memo1.Lines[i]); PosReturn := Pos(Form1.Memo1.Lines.Strings[0],Form1.Memo1.Lines[i]); end; Close; Form1.Memo1.SetFocus; SkipChars := SkipChars + PosReturn; Form1.Memo1.SelStart := SkipChars + (LineNum * 2); Form1.Memo1.SelLength := 1; end else begin MessageDlg('Line Number Out of Range',mtWarning,[mbOk],0); Edit1.Text := IntToStr(Form1.Memo1.Lines.Count); Edit1.SelectAll; end; except MessageDlg('''' + Edit1.Text + '''' +' is Not a valid integer value',mtError,[mbOk],0); end; end; procedure TfrmGoTo.FormShow(Sender: TObject); begin Edit1.Text := '1'; Edit1.SelectAll; end; end. ------------------------------------------------ Unit Two Form File: GoToForm.dfm ------------------------------------------------ object frmGoTo: TfrmGoTo Left = 100 Top = 108 Width = 211 Height = 88 ActiveControl = Edit1 BorderIcons = [biSystemMenu] Caption = 'Go To Line' Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'MS Sans Serif' Font.Style = [] OldCreateOrder = False Position = poScreenCenter OnShow = FormShow PixelsPerInch = 96 TextHeight = 13 object Edit1: TEdit Left = 2 Top = 3 Width = 121 Height = 21 TabOrder = 0 Text = '1' end object BitBtn1: TBitBtn Left = 126 Top = 3 Width = 75 Height = 25 TabOrder = 1 OnClick = BitBtn1Click Kind = bkOK end object BitBtn2: TBitBtn Left = 126 Top = 35 Width = 75 Height = 25 TabOrder = 2 Kind = bkCancel end end I have also attached the entire source code as a zipped file (DelphiNotepad.zip) that you can download. I would appreciate if you people can give it a try and share your comments on this. Thanks. Magesh.