Author: S S B Magesh Puvananthiran
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
1 program DelphiNotepad;
2
3 uses
4 Forms,
5 NotePad1 in 'NotePad1.pas' {Form1},
6 GoToForm in 'GoToForm.pas' {frmGoTo};
7
8 {$R *.res}
9
10 begin
11 Application.Initialize;
12 Application.Title := 'Delphi Notepad';
13 Application.CreateForm(TForm1, Form1);
14 Application.CreateForm(TfrmGoTo, frmGoTo);
15 Application.Run;
16 end.
17
18 //Unit One Code: Notepad1.pas
19
20 unit NotePad1;
21 {
22 Unit Name : NotePad1.pas
23 Developed By : S S B Magesh Puvananthiran
24 Description : A simple notepad developed with Delphi 6
25 }
26 interface
27
28 uses
29 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
30 Dialogs, StdCtrls, ConvUtils, Menus, ComCtrls, StrUtils, ExtDlgs;
31
32 type
33 TForm1 = class(TForm)
34 Memo1: TMemo;
35 MainMenu1: TMainMenu;
36 FileMenu: TMenuItem;
37 FileNew: TMenuItem;
38 FileOpen: TMenuItem;
39 EditMenu: TMenuItem;
40 Undo: TMenuItem;
41 N1: TMenuItem;
42 Cut: TMenuItem;
43 Copy: TMenuItem;
44 Paste: TMenuItem;
45 SelectAll1: TMenuItem;
46 FormatMenu: TMenuItem;
47 WordWrap: TMenuItem;
48 FileSave: TMenuItem;
49 Exit2: TMenuItem;
50 FileExit: TMenuItem;
51 SelectAll: TMenuItem;
52 Font: TMenuItem;
53 HelpMenu: TMenuItem;
54 AboutNotepad: TMenuItem;
55 TimeDate: TMenuItem;
56 OpenDialog1: TOpenDialog;
57 SaveDialog1: TSaveDialog;
58 StatusBar1: TStatusBar;
59 FontDialog1: TFontDialog;
60 SaveAs1: TMenuItem;
61 FilePrint: TMenuItem;
62 N2: TMenuItem;
63 PrintDialog1: TPrintDialog;
64 PrinterSetupDialog1: TPrinterSetupDialog;
65 FindDialog1: TFindDialog;
66 N3: TMenuItem;
67 Find: TMenuItem;
68 FindNext: TMenuItem;
69 Replace: TMenuItem;
70 GoTo1: TMenuItem;
71 ReplaceDialog1: TReplaceDialog;
72 BackgroundColor: TMenuItem;
73 ColorDialog1: TColorDialog;
74 Options1: TMenuItem;
75 WantTabs1: TMenuItem;
76 WantReturns1: TMenuItem;
77 procedure FileExitClick(Sender: TObject);
78 procedure AboutNotepadClick(Sender: TObject);
79 procedure FileOpenClick(Sender: TObject);
80 procedure FileSaveClick(Sender: TObject);
81 procedure FileNewClick(Sender: TObject);
82 procedure WordWrapClick(Sender: TObject);
83 procedure FontClick(Sender: TObject);
84 procedure UndoClick(Sender: TObject);
85 procedure CutClick(Sender: TObject);
86 procedure CopyClick(Sender: TObject);
87 procedure PasteClick(Sender: TObject);
88 procedure SelectAllClick(Sender: TObject);
89 procedure TimeDateClick(Sender: TObject);
90 procedure Memo1Change(Sender: TObject);
91 procedure Memo1MouseUp(Sender: TObject; Button: TMouseButton;
92 Shift: TShiftState; X, Y: Integer);
93 procedure Memo1KeyUp(Sender: TObject; var Key: Word;
94 Shift: TShiftState);
95 procedure FormCreate(Sender: TObject);
96 procedure SaveAs1Click(Sender: TObject);
97 procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
98 procedure FilePrintClick(Sender: TObject);
99 procedure PageSetupClick(Sender: TObject);
100 procedure FindDialog1Find(Sender: TObject);
101 procedure FindClick(Sender: TObject);
102 procedure FindNextClick(Sender: TObject);
103 procedure ReplaceClick(Sender: TObject);
104 procedure ReplaceDialog1Replace(Sender: TObject);
105 procedure ReplaceDialog1Find(Sender: TObject);
106 procedure GoTo1Click(Sender: TObject);
107 procedure BackgroundColorClick(Sender: TObject);
108 procedure WantTabs1Click(Sender: TObject);
109 procedure WantReturns1Click(Sender: TObject);
110 private
111 procedure OpenTheFile;
112 function SaveChanges: Boolean;
113 { Private declarations }
114 public
115 { Public declarations }
116 end;
117
118 var
119 Form1: TForm1;
120
121 implementation
122
123 uses GoToForm;
124
125 {$R *.dfm}
126
127 procedure TForm1.AboutNotepadClick(Sender: TObject);
128 begin
129 ShowMessage(' Delphi Notepad ' + #13 +
130 ' Developed with Borland Delphi 6 Enterprise Trial Edition');
131 end;
132
133 procedure TForm1.FileExitClick(Sender: TObject);
134 begin
135 Close;
136 end;
137
138 procedure TForm1.FileOpenClick(Sender: TObject);
139 begin
140 if not (Memo1.Modified) then
141 OpenTheFile
142 else if (Memo1.Modified) then
143 begin
144 ModalResult := MessageDlg('Save Changes?', mtConfirmation, [mbYes, mbNo,
145 mbCancel], 0);
146 if ((ModalResult = mrYes) and (SaveChanges)) or (ModalResult = mrNo) then
147 begin
148 OpenTheFile;
149 Memo1.Modified := False;
150 end;
151 end;
152 end;
153
154 procedure TForm1.FileSaveClick(Sender: TObject);
155 begin
156 if SaveChanges then
157 Memo1.Modified := False;
158 end;
159
160 procedure TForm1.FileNewClick(Sender: TObject);
161 begin
162 if not (Memo1.Modified) then
163 begin
164 Memo1.Clear;
165 Form1.Caption := 'UnNamed - Delphi Notepad';
166 OpenDialog1.FileName := '';
167 SaveDialog1.FileName := '';
168 end
169 else if (Memo1.Modified) then
170 begin
171 ModalResult := MessageDlg('Save Changes?', mtConfirmation, [mbYes, mbNo,
172 mbCancel], 0);
173 if (ModalResult = mrYes) and (SaveChanges) then
174 begin
175 Memo1.Clear;
176 Form1.Caption := 'UnNamed - Delphi Notepad';
177 Memo1.Modified := False;
178 OpenDialog1.FileName := '';
179 SaveDialog1.FileName := '';
180 end
181 else if ModalResult = mrNo then
182 begin
183 Memo1.Clear;
184 Form1.Caption := 'UnNamed - Delphi Notepad';
185 OpenDialog1.FileName := '';
186 SaveDialog1.FileName := '';
187 Memo1.Modified := False;
188 end;
189 end;
190 end;
191
192 procedure TForm1.OpenTheFile;
193 begin
194 if OpenDialog1.Execute then
195 begin
196 Memo1.Lines.LoadFromFile(OpenDialog1.FileName);
197 Form1.Caption := OpenDialog1.FileName + ' - ' + 'Delphi Notepad';
198 end;
199 end;
200
201 function TForm1.SaveChanges: Boolean;
202 begin
203 Result := False;
204 if (OpenDialog1.FileName = '') and (SaveDialog1.FileName = '') then
205 begin
206 if SaveDialog1.Execute then
207 begin
208 Screen.Cursor := crHourGlass;
209 StatusBar1.SimpleText := 'Saving...';
210 Memo1.Lines.SaveToFile(SaveDialog1.FileName);
211 Form1.Caption := SaveDialog1.FileName + ' - ' + 'Delphi Notepad';
212 StatusBar1.SimpleText := 'Ready';
213 Screen.Cursor := crDefault;
214 Result := True;
215 end;
216 end
217 else
218 begin
219 Screen.Cursor := crHourGlass;
220 StatusBar1.SimpleText := 'Saving...';
221 if OpenDialog1.FileName <> '' then
222 begin
223 Memo1.Lines.SaveToFile(OpenDialog1.FileName);
224 Form1.Caption := OpenDialog1.FileName + ' - ' + 'Delphi Notepad';
225 end
226 else if SaveDialog1.FileName <> '' then
227 begin
228 Memo1.Lines.SaveToFile(SaveDialog1.FileName);
229 Form1.Caption := SaveDialog1.FileName + ' - ' + 'Delphi Notepad';
230 end;
231
232 StatusBar1.SimpleText := 'Ready';
233 Screen.Cursor := crDefault;
234 Result := True;
235 end;
236 end;
237
238 procedure TForm1.WordWrapClick(Sender: TObject);
239 begin
240 if WordWrap.Checked then
241 begin
242 Memo1.WordWrap := True;
243 Memo1.ScrollBars := ssVertical;
244 end
245 else
246 begin
247 Memo1.WordWrap := False;
248 Memo1.ScrollBars := ssBoth;
249 end;
250 end;
251
252 procedure TForm1.FontClick(Sender: TObject);
253 begin
254 if FontDialog1.Execute then
255 begin
256 Memo1.Font := FontDialog1.Font;
257 Memo1.Font.Color := FontDialog1.Font.Color;
258 end;
259 end;
260
261 procedure TForm1.UndoClick(Sender: TObject);
262 begin
263 if (Memo1.Modified) and (Memo1.CanUndo) then
264 Memo1.Undo;
265 end;
266
267 procedure TForm1.CutClick(Sender: TObject);
268 begin
269 Memo1.CutToClipboard;
270 end;
271
272 procedure TForm1.CopyClick(Sender: TObject);
273 begin
274 Memo1.CopyToClipboard;
275 end;
276
277 procedure TForm1.PasteClick(Sender: TObject);
278 begin
279 Memo1.PasteFromClipboard;
280 end;
281
282 procedure TForm1.SelectAllClick(Sender: TObject);
283 begin
284 Memo1.SelectAll;
285 end;
286
287 procedure TForm1.TimeDateClick(Sender: TObject);
288 begin
289 Memo1.SelText := DateToStr(Now) + TimeToStr(Time);
290 end;
291
292 procedure TForm1.Memo1Change(Sender: TObject);
293 begin
294 if (Memo1.Modified) and (Memo1.CanUndo) then
295 Undo.Enabled := True
296 else
297 Undo.Enabled := False;
298 end;
299
300 procedure TForm1.Memo1MouseUp(Sender: TObject; Button: TMouseButton;
301 Shift: TShiftState; X, Y: Integer);
302 begin
303 if Memo1.SelText <> '' then
304 begin
305 Cut.Enabled := True;
306 Copy.Enabled := True;
307 end
308 else
309 begin
310 Cut.Enabled := False;
311 Copy.Enabled := False;
312 end;
313 end;
314
315 procedure TForm1.Memo1KeyUp(Sender: TObject; var Key: Word;
316 Shift: TShiftState);
317 begin
318 if Memo1.SelText <> '' then
319 begin
320 Cut.Enabled := True;
321 Copy.Enabled := True;
322 end
323 else
324 begin
325 Cut.Enabled := False;
326 Copy.Enabled := False;
327 end;
328 end;
329
330 procedure TForm1.FormCreate(Sender: TObject);
331 begin
332 Form1.Caption := 'UnNamed - Delphi Notepad';
333 end;
334
335 procedure TForm1.SaveAs1Click(Sender: TObject);
336 begin
337 if SaveDialog1.Execute then
338 begin
339 Memo1.Lines.SaveToFile(SaveDialog1.FileName);
340 Form1.Caption := SaveDialog1.FileName + ' - Delphi Notepad';
341 Memo1.Clear;
342 Memo1.Lines.LoadFromFile(SaveDialog1.FileName);
343 end;
344 end;
345
346 procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
347 begin
348 if (Memo1.Modified) then
349 begin
350 ModalResult := MessageDlg('Save Changes?', mtConfirmation, [mbYes, mbNo,
351 mbCancel], 0);
352 if ((ModalResult = mrYes) and (SaveChanges)) or (ModalResult = mrNo) then
353 CanClose := True
354 else
355 CanClose := False;
356 end
357 else if not (Memo1.Modified) then
358 CanClose := True;
359 end;
360
361 procedure TForm1.FilePrintClick(Sender: TObject);
362 begin
363 if PrintDialog1.Execute then
364 Print
365 else
366 PrinterSetupDialog1.Execute;
367 end;
368
369 procedure TForm1.PageSetupClick(Sender: TObject);
370 begin
371 PrinterSetupDialog1.Execute;
372 end;
373
374 procedure TForm1.FindDialog1Find(Sender: TObject);
375 var
376 I, J, PosReturn, SkipChars: Integer;
377 CursorPos: TPoint;
378 begin
379 CursorPos := Memo1.CaretPos;
380 if frDown in FindDialog1.Options then
381 begin
382 for I := CursorPos.Y + 1 to Memo1.Lines.Count do
383 begin
384 PosReturn := Pos(FindDialog1.FindText, Memo1.Lines[I]);
385 if (PosReturn <> 0) then
386 begin
387 SkipChars := 0;
388 for J := 0 to I - 1 do
389 SkipChars := SkipChars + Length(Memo1.Lines[J]);
390 SkipChars := SkipChars + (I * 2);
391 SkipChars := SkipChars + PosReturn - 1;
392
393 Memo1.SelStart := SkipChars;
394 Memo1.SelLength := Length(FindDialog1.FindText);
395 Break;
396 end;
397 end;
398 end
399 else
400 begin
401 for I := CursorPos.Y - 1 downto 0 do
402 begin
403 PosReturn := Pos(FindDialog1.FindText, Memo1.Lines[I]);
404 if PosReturn <> 0 then
405 begin
406 SkipChars := 0;
407 for J := 0 to I - 1 do
408 SkipChars := SkipChars + Length(Memo1.Lines[J]);
409 SkipChars := SkipChars + (I * 2);
410 SkipChars := SkipChars + PosReturn - 1;
411
412 Memo1.SelStart := SkipChars;
413 Memo1.SelLength := Length(FindDialog1.FindText);
414 Break;
415 end;
416 end;
417 end;
418 end;
419
420 procedure TForm1.FindClick(Sender: TObject);
421 begin
422 FindDialog1.Execute;
423 end;
424
425 procedure TForm1.FindNextClick(Sender: TObject);
426 begin
427 FindDialog1Find(nil);
428 end;
429
430 procedure TForm1.ReplaceClick(Sender: TObject);
431 begin
432 ReplaceDialog1.Execute;
433 end;
434
435 procedure TForm1.ReplaceDialog1Replace(Sender: TObject);
436 var
437 CursorPos: TPoint;
438 I, J, SkipChars, PosReturn: integer;
439 begin
440 if frReplace in ReplaceDialog1.Options then
441 Memo1.SelText := ReplaceDialog1.ReplaceText
442 else if frReplaceAll in ReplaceDialog1.Options then
443 begin
444 CursorPos := Memo1.CaretPos;
445 for I := CursorPos.Y + 1 to Memo1.Lines.Count do
446 begin
447 PosReturn := Pos(ReplaceDialog1.FindText, Memo1.Lines[I]);
448 if PosReturn <> 0 then
449 begin
450 SkipChars := 0;
451 for J := 0 to I - 1 do
452 SkipChars := SkipChars + Length(Memo1.Lines[J]);
453 SkipChars := SkipChars + (I * 2);
454 SkipChars := SkipChars + PosReturn - 1;
455
456 Memo1.SelStart := SkipChars;
457 Memo1.SelLength := Length(ReplaceDialog1.FindText);
458 Memo1.SelText := ReplaceDialog1.ReplaceText;
459 end;
460 end;
461 end;
462 end;
463
464 procedure TForm1.ReplaceDialog1Find(Sender: TObject);
465 var
466 I, J, PosReturn, SkipChars: Integer;
467 CursorPos: TPoint;
468 begin
469 CursorPos := Memo1.CaretPos;
470 for I := CursorPos.Y + 1 to Memo1.Lines.Count do
471 begin
472 PosReturn := Pos(ReplaceDialog1.FindText, Memo1.Lines[I]);
473 if PosReturn <> 0 then
474 begin
475 SkipChars := 0;
476 for J := 0 to I - 1 do
477 SkipChars := SkipChars + Length(Memo1.Lines[J]);
478 SkipChars := SkipChars + (I * 2);
479 SkipChars := SkipChars + PosReturn - 1;
480
481 Memo1.SelStart := SkipChars;
482 Memo1.SelLength := Length(ReplaceDialog1.FindText);
483 Break;
484 end;
485 end;
486 end;
487
488 procedure TForm1.GoTo1Click(Sender: TObject);
489 begin
490 frmGoTo.ShowModal;
491 end;
492
493 procedure TForm1.BackgroundColorClick(Sender: TObject);
494 begin
495 if ColorDialog1.Execute then
496 Memo1.Color := ColorDialog1.Color;
497 end;
498
499 procedure TForm1.WantTabs1Click(Sender: TObject);
500 begin
501 if WantTabs1.Checked then
502 Memo1.WantTabs := True
503 else
504 Memo1.WantTabs := False;
505 end;
506
507 procedure TForm1.WantReturns1Click(Sender: TObject);
508 begin
509 if WantReturns1.Checked then
510 Memo1.WantReturns := True
511 else
512 Memo1.WantReturns := False;
513 end;
514
515 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
516 unit GoToForm;
517 {
518 Unit Name : GoToForm.pas
519 Developed By : S S B Magesh Puvananthiran
520 Description : A simple form to enter the line number.
521 }
522 interface
523
524 uses
525 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
526 Dialogs, StdCtrls, Buttons;
527
528 type
529 TfrmGoTo = class(TForm)
530 Edit1: TEdit;
531 BitBtn1: TBitBtn;
532 BitBtn2: TBitBtn;
533 procedure BitBtn1Click(Sender: TObject);
534 procedure FormShow(Sender: TObject);
535 private
536 { Private declarations }
537 public
538 { Public declarations }
539 end;
540
541 var
542 frmGoTo: TfrmGoTo;
543
544 implementation
545
546 uses NotePad1;
547
548 {$R *.dfm}
549
550 procedure TfrmGoTo.BitBtn1Click(Sender: TObject);
551 var
552 LineNum, PosReturn, i, SkipChars: integer;
553 begin
554 try
555 PosReturn := 0;
556 LineNum := StrToInt(Edit1.Text) - 1;
557 if (LineNum >= 1) and (LineNum + 1 <= Form1.Memo1.Lines.Count - 1) then
558 begin
559 SkipChars := 0;
560 for i := 0 to LineNum - 1 do
561 begin
562 SkipChars := SkipChars + Length(Form1.Memo1.Lines[i]);
563 PosReturn := Pos(Form1.Memo1.Lines.Strings[0], Form1.Memo1.Lines[i]);
564 end;
565 Close;
566 Form1.Memo1.SetFocus;
567 SkipChars := SkipChars + PosReturn;
568 Form1.Memo1.SelStart := SkipChars + (LineNum * 2);
569 Form1.Memo1.SelLength := 1;
570 end
571 else
572 begin
573 MessageDlg('Line Number Out of Range', mtWarning, [mbOk], 0);
574 Edit1.Text := IntToStr(Form1.Memo1.Lines.Count);
575 Edit1.SelectAll;
576 end;
577 except
578 MessageDlg('''' + Edit1.Text + '''' + ' is Not a valid integer value', mtError,
579 [mbOk], 0);
580 end;
581 end;
582
583 procedure TfrmGoTo.FormShow(Sender: TObject);
584 begin
585 Edit1.Text := '1';
586 Edit1.SelectAll;
587 end;
588
589 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: http://www.baltsoft.com/files/dkb/attachment/DelphiNotepad.zip
|
