2011. május 29., vasárnap
A Simple Notepad with Delphi 6
Problem/Question/Abstract:
A Simple Notepad with Delphi (though reinventing the wheel)
Answer:
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, it’s 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
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 <= Form1.Memo1.Lines.Count - 1) then
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
Component Download: DelphiNotepad.zip
Feliratkozás:
Megjegyzések küldése (Atom)
Nincsenek megjegyzések:
Megjegyzés küldése