mainformunit.pas

用DELPHI做的记事本 类似与WINDOWS中的记事本一样,包括删除,新建

procedure TMainForm.FormCreate(Sender: TObject);
begin
  ret.WordWrap:=false;
  FileName:='无标题';
  DragAcceptFiles(Handle,True);
end;

procedure TMainForm.FileNewClick(Sender: TObject);
begin
  CheckText;

  if IfFileChange=true then
    BackStart;

end;


procedure TMainForm.FileOpenClick(Sender: TObject);
begin
  CheckText;

  if IfFileChange=true then
    begin
      if Open.Execute then
        begin
          RET.Lines.LoadFromFile(Open.FileName);
          mainform.Caption:=GetFileName(Open.FileName)+' - 记事本';
          FileName:=GetFileName(Open.FileName);
          RET.Modified:=false;
          Open.FileName:='*.txt';
        end
    end
end;

procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  CheckText;
  CanClose:=IfFileChange;
end;

procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  LoginForm.Close;
end;

procedure TMainForm.FileSaveClick(Sender: TObject);
begin
  FileSaveP;
end;

procedure TMainForm.FileSaveAsClick(Sender: TObject);
begin
  FileSaveAsP;
end;

procedure TMainForm.ExitClick(Sender: TObject);
begin
  CheckText;
  if IfFileChange = True then
    close;
end;

procedure TMainForm.FileUndoClick(Sender: TObject);
begin
  RET.Perform(em_undo,0,0);
end;

procedure TMainForm.FileCutClick(Sender: TObject);
begin
  RET.CutToClipboard;
end;

procedure TMainForm.FilePasteClick(Sender: TObject);
begin
  RET.PasteFromClipboard;  
end;

procedure TMainForm.FileCopyClick(Sender: TObject);
begin
  RET.CopyToClipboard;
end;

procedure TMainForm.FileDelClick(Sender: TObject);
begin
  RET.Perform(wm_clear,0,0);
end;

procedure TMainForm.FileFindClick(Sender: TObject);
begin
  Find.Execute;
end;

procedure TMainForm.FindFind(Sender: TObject);
var FoundAt:LongInt;
var StartPos, ToEnd:Integer;
begin
  if RET.SelLength<>0 then
    StartPos:=RET.SelStart + RET.SelLength
  else
    StartPos:=0;
  ToEnd:=Length(Ret.Text) - StartPos;
  FoundAt:=ret.FindText(find.FindText,startpos,toend,[stMatchCase]);
  if FoundAt <> -1 then
  begin
    ret.SetFocus;
    ret.SelStart:=FoundAt;
    ret.SelLength:=Length(find.FindText);
  end
  else
    messagedlg('查找完成',mtWarning,[mbOk],0);
end;



procedure TMainForm.FileReplaceClick(Sender: TObject);
var
  p: tpoint;
begin
  p := point(0,0);
  p := ret.ClientToScreen(p);
  replace.Position := p;
  replace.Execute;
end;



procedure TMainForm.ReplaceReplace(Sender: TObject);
var
  FoundAt: longint;
  StartPos, ToEnd: integer;
  st: TSearchTypes;
begin
  with RET do
  begin
    StartPos := SelStart;  // + SelLength;
    ToEnd := Length(ret.Text) - StartPos;
    st := [];
    if frMatchCase in replace.Options then
      st := st + [stMatchCase];
    if frWholeWord in replace.Options then
      st := st + [stWholeWord];
    FoundAt := FindText(replace.FindText, StartPos, ToEnd, st);
    while FoundAt <> -1 do
    begin
      SelStart := FoundAt;
      SelLength := Length(replace.FindText);
      perform(em_replacesel, 1, integer(pchar(replace.ReplaceText)));
      SelStart := FoundAt;
      SelLength := Length(replace.ReplaceText);
      if not (frReplaceAll in replace.Options) then
        break;
      StartPos := SelStart;
      ToEnd := Length(ret.Text) - StartPos;
      FoundAt := FindText(replace.FindText, StartPos, ToEnd, st);
    end;
    FoundAt := FindText(replace.FindText, StartPos, ToEnd, st);
    if FoundAt = -1 then
      messagedlg('替换完成',mtWarning,[mbOk],0);
  end;
end;

procedure TMainForm.ReplaceFind(Sender: TObject);
var
  FoundAt: longint;
  StartPos, ToEnd: integer;
  st: TSearchTypes;
begin
  with RET do
  begin
    StartPos := SelStart +SelLength;
    ToEnd := Length(ret.Text) - StartPos;
    st := [];
    if frMatchCase in replace.Options then
      st := st + [stMatchCase];
    if frWholeWord in replace.Options then
      st := st + [stWholeWord];
    FoundAt := FindText(replace.FindText, StartPos, ToEnd, st);
    if FoundAt <> -1 then
    begin
      SelStart := FoundAt;
      SelLength := Length(replace.FindText);
    end
    else
      messagedlg('查找完成',mtWarning,[mbOk],0);
  end;
end;

procedure TMainForm.FileGotoClick(Sender: TObject);
var
  gotoln:integer;
  iRow, iCol:integer;
begin
  IROW:=RET.CaretPos.Y+1;
  gotoln:=strtoint(InputBox('转到下列行', '行数(&L)',inttostr(irow)));
  IF (gotoln>RET.Lines.Count) then
    showmessage('行数超过范围')
  else
    begin
      iRow :=gotoln;
      iCol := 0;
      SetCaret(RET, iRow, iCol);
      ret.SetFocus;
    end;
end;

procedure TMainForm.FileSelAllClick(Sender: TObject);
begin
  RET.SelectAll;
end;

procedure TMainForm.FileDateClick(Sender: TObject);
begin 
  RET.SelText := TimeToStr(now) + ' ' + DateToStr(now);
end;

procedure TMainForm.WordWrapClick(Sender: TObject);
begin
  RET.WordWrap:= not ret.WordWrap;
  wordWrap.Checked:= Ret.WordWrap;

  if wordWrap.Checked=true then
    Ret.ScrollBars:=ssVertical
  else
    Ret.ScrollBars:=ssBoth
end;

procedure TMainForm.FileFontClick(Sender: TObject);
begin
  if Font.Execute then
    RET.Font:=font.Font;
end;

procedure TMainForm.FileSBARClick(Sender: TObject);
begin
  FileSbar.Checked:=not FileSbar.Checked;
  
  if FileSbar.Checked=true then
    sbar.Show
  else
    sbar.Hide
end;

procedure TMainForm.FileWindowClick(Sender: TObject);
begin
  TBAr1.Visible:=not TBAr1.Visible;
  FileWindow.Checked:=not FileWindow.Checked;
end;


procedure TMainForm.FileHelpClick(Sender: TObject);
begin
  shellExecute(handle,'open','C:\WINDOWS\Help\notepad.chm', nil, nil, sw_show);
end;

procedure TMainForm.FileAboutClick(Sender: TObject);
begin
  AboutForm.Show;
end;

procedure TMainForm.Timer1Timer(Sender: TObject);
begin
  Sbar.Panels[1].Text:='Ln:'+inttostr(ret.CaretPos.y)+','+' '
                        +'Col:'+inttostr(ret.CaretPos.x);

  if TBAR1.Visible=True then
    Sbar.Panels[0].Text:='正在使用的记事本界面为：写字板格式'
  else
    Sbar.Panels[0].Text:='正在使用的记事本界面为：标准记事本';
  ButtonDisplay;


end;

procedure TMainForm.RETKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  IF (KEY=VK_F1) THEN
    shellExecute(handle,'open','C:\WINDOWS\Help\notepad.chm', nil, nil, sw_show);
end;

procedure TMainForm.PageSetupClick(Sender: TObject);
begin
  PageSetupD.Execute;
end;

procedure TMainForm.FilePrintClick(Sender: TObject);
begin
  PrintD.Execute;
end;

end.