HanDs
NO.2

[Delphi文章] 标准记事本Delphi源码 





学习中请遵循国家相关法律法规,黑客不作恶。没有网络安全就没有国家安全

本站需要登陆后才能查看

private
     { Private declarations }   
     procedure DropFiles(var Msg: TMessage); message WM_DROPFILES;//拖动打开文件
     procedure OpenFile(Sender: TObject; FName: String);//打开文件
     function CheckFileSave(Sender: TObject):Integer;//检查文件保存与否
     procedure SaveFile(Sender: TObject; Style: Integer);//保存文件
     procedure UpdateCaption(Sender: TObject); //更新标题
     function PerformFind(Sender: TObject; FindString: String; SearchType: TSearchTypes):Boolean;//查找下一个
   public
     { Public declarations }
     p:TWinControl;
     A:TAnchors;
     X,Y,W,H,N:INTEGER;
     FindTextOld:string;
   end;

var
   MainForm: TMainForm;
   FileName, FileNameC: string;

implementation

uses Setfrm;

{$R *.dfm}

//**********自定义函数区**********//
//----------begin----------//

//{{{{{{{{{{拖动打开文件{{{{{{{{{{//
procedure TMainForm.DropFiles(var Msg: TMessage);
var i, Count: integer;
   buffer: array[0..1024] of Char;
begin
   inherited;
   Count := DragQueryFile(Msg.WParam, $FFFFFFFF, nil, 256); // 第一次调用得到拖放文件的个数
   for i := 0 to Count - 1 do
   begin
     buffer[0] := #0;
     DragQueryFile(Msg.WParam, i, buffer, sizeof(buffer)); // 第二次调用得到文件名称
     Richedit1.Lines.LoadFromFile(buffer);
   end;
   FileName:= buffer;
   {FileNameC:= FileName;
   while Pos('\',FileNameC) > 0 do
       Delete(FileNameC,1,1); }
   Caption := '文本替换软件-'+ExtractFilename(FileName);
end;
//}}}}}}}}}}end}}}}}}}}}}//


//{{{{{{{{{{打开文件{{{{{{{{{{//
procedure TMainForm.OpenFile(Sender: TObject; FName: String);
begin
   if CheckFileSave(Sender)=IDCANCEL then
     Exit;
   if FName='' then
   begin
     OpenDialog1.Filter:=DefaultFilter;
     OpenDialog1.InitialDir:=ExtractFilePath(FileName);
     OpenDialog1.FileName:='';
     if OpenDialog1.Execute then
     begin
       if FileName=OpenDialog1.FileName then
       begin
         //Application.MessageBox(Pchar('文件 '+FileName+' 已经打开。'),'错误',MB_ICONINFORMATION);
         //exit;
       end
       else
         FileName:=OpenDialog1.FileName;
       end
     else
       Exit;
   end
   else
     if not FileExists(FName) then
     begin
       Application.MessageBox('此文件不存在!','打开',MB_ICONINFORMATION);
       Exit;
     end
     else if FName=FileName then
     begin
       //Application.MessageBox(Pchar('文件 '+FileName+' 已经打开。'),'错误',MB_ICONINFORMATION);
       //Exit;
     end
     else
       FileName:=FName;
   try
     RichEdit1.PlainText:=not (UpperCase(ExtractFileExt(FileName))='.RTF');
     Screen.Cursor:=crHourGlass;
     Refresh;
     RichEdit1.Lines.LoadFromFile(FileName);
   finally
     Screen.Cursor:=crDefault;
     UpdateCaption(Sender);
   end;
end;
//}}}}}}}}}}end}}}}}}}}}}//

//{{{{{{{{{{检查文件保存与否{{{{{{{{{{//
function TMainForm.CheckFileSave(Sender: TObject):Integer;
var
   Response:Integer;
   TempName:String;
begin
   Response:=-1;
   if Length(FileName)<>0 then
     TempName:=FileName
   else
     TempName:='无标题';
   if RichEdit1.Modified then
     Response:=Application.MessageBox(Pchar('文件 '+TempName+
         ' 的内容已经改变。'+NewLine+'想保存文件吗?'),
         Pchar(Application.Title),MB_ICONQUESTION+MB_YESNOCANCEL+MB_DEFBUTTON1);
   if Response=IDYES then
     SaveFile(Sender,0);
   Result:=Response;
end;
//}}}}}}}}}}end}}}}}}}}}}//

//{{{{{{{{{{保存文件{{{{{{{{{{//
procedure TMainForm.SaveFile(Sender: TObject; Style: Integer);
var
   I:Integer;
   TempName:String;
begin
   SaveDialog1.Filter:=DefaultFilter;
   SaveDialog1.FileName:=FileName;
   TempName:=FileName;
   if FileName='' then
   begin
     SaveDialog1.Title:='保存';
     SaveDialog1.FileName:=Trim(RichEdit1.Lines[0]);
     if SaveDialog1.FileName<>'' then
       for I:=1 to Length(SaveDialog1.FileName) do
       if SaveDialog1.FileName in ['/','\','*','?','<','>','|'] then
       begin
         SaveDialog1.FileName:='*.txt';
         break;
       end;
     if SaveDialog1.Execute then
       try
         FileName:=SaveDialog1.FileName;
         RichEdit1.Lines.SaveToFile(FileName);
         UpdateCaption(Sender);
       except
         Application.MessageBox(Pchar(Application.Title+'无法保存文件 '+FileName+' 。'),'错误',MB_ICONINFORMATION);
       end;
   end
   else
   begin
     if Style=1 then           //另存为...
     begin
       SaveDialog1.Title:='另存为';
       if SaveDialog1.Execute then
         tempname:=SaveDialog1.FileName;
     end;
     try
       RichEdit1.Lines.SaveToFile(TempName);
       RichEdit1.Modified:=False;
     except
       Application.MessageBox(Pchar(Application.Title+'无法保存文件 '+FileName+' 。'),'错误',MB_ICONINFORMATION);
     end;
   end;
end; 
//}}}}}}}}}}end}}}}}}}}}}//

//{{{{{{{{{{更新标题{{{{{{{{{{//
procedure TMainForm.UpdateCaption(Sender: TObject);
begin
   if Length(FileName)<>0 then
       Caption:=Application.Title+' - '+ExtractFileName(FileName)
   else
     Caption:=Application.Title+' - 未命名';
   RichEdit1.Modified:=False;
end;
//}}}}}}}}}}end}}}}}}}}}}//

//{{{{{{{{{{查找下一个{{{{{{{{{{//
function TMainForm.PerformFind(Sender: TObject; FindString: String; SearchType: TSearchTypes):Boolean;
var
   FoundAt, StartPos, ToEnd: Integer;
   str:string;
   label Start;
begin
   if FindTextOld = FindString then
     with RichEdit1 do
     begin
       Start: StartPos:=SelStart+SelLength;
       ToEnd:=GetTextLen-StartPos;
       FoundAt:=FindText(FindString,StartPos,ToEnd,SearchType);
       if FoundAt<>-1 then
       begin
         SelStart:=FoundAt;
         SelLength:=Length(FindString);
         if Seltext='' then
         begin
           Selstart:=Selstart+2;
           goto Start;
         end;
         Result:=True;
       end
       else
       begin
         str:= '找不到 '''''+PChar(FindString)+'''''';
         Application.MessageBox(PChar(str),'记事本',MB_ICONINFORMATION);
         FindDialog.CloseDialog;
         Result:=False;
       end;
     end
   else
   begin
     FindTextOld:= FindString;
     Result:=True;
   end;
end;
//}}}}}}}}}}end}}}}}}}}}}//

//{{{{{{{{{{取程序版本号{{{{{{{{{{//
function GetFileVersion(FileName: string): string;
   type
     PVerInfo = ^TVS_FIXEDFILEINFO;
     TVS_FIXEDFILEINFO = record
       dwSignature: longint;
       dwStrucVersion: longint;
       dwFileVersionMS: longint;
       dwFileVersionLS: longint;
       dwFileFlagsMask: longint;
       dwFileFlags: longint;
       dwFileOS: longint;
       dwFileType: longint;
       dwFileSubtype: longint;
       dwFileDateMS: longint;
       dwFileDateLS: longint;
     end;
var
   ExeNames: array[0..255] of char;
   //zKeyPath: array[0..255] of Char;
   VerInfo: PVerInfo;
   Buf: pointer;
   Sz: word;
   L, Len: Cardinal;
begin
   StrPCopy(ExeNames, FileName);
   Sz := GetFileVersionInfoSize(ExeNames, L);
   if Sz=0 then
   begin
     Result:='';
     Exit;
   end;

   try
     GetMem(Buf, Sz);
     try
       GetFileVersionInfo(ExeNames, 0, Sz, Buf);
       if VerQueryValue(Buf, '\', Pointer(VerInfo), Len) then
       begin
         Result := 'V'+IntToStr(HIWORD(VerInfo.dwFileVersionMS)) + '.' +
         IntToStr(LOWORD(VerInfo.dwFileVersionMS)) + '.' +
         IntToStr(HIWORD(VerInfo.dwFileVersionLS)) + '.' +
         IntToStr(LOWORD(VerInfo.dwFileVersionLS));

       end;
     finally
       FreeMem(Buf);
     end;
   except
     Result := '-1';
   end;
end;
//}}}}}}}}}}end}}}}}}}}}}//

//----------end----------//
//**********//


//**********窗体创建与关闭**********//
//----------begin----------//
procedure TMainForm.FormCreate(Sender: TObject);
var
   i: Integer;
begin
   //“选择程序中”打开文件的代码
   for i:=1 to ParamCount do
     Filename:=Filename+ParamStr(I)+'';
   if FileExists(Filename) then
     OpenFile(Sender,Filename);
   DragAcceptFiles(Handle, True);
   N:=0;
end;

procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
   Action:=caFree;//关闭窗体
end;

procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
   CanClose:=not (CheckFileSave(Sender)=IDCANCEL);//检查文件保存与否
end;
//----------end----------//
//**********//


//**********菜单功能代码**********//
//----------begin----------//

//新建文件
procedure TMainForm.M_NewFilesClick(Sender: TObject);
begin
   if CheckFileSave(Sender)<>IDCANCEL then
     begin
       RichEdit1.Lines.Clear;
       FileName:='';
       UpdateCaption(Sender);
     end;
end;

//打开文件
procedure TMainForm.M_OpenFilesClick(Sender: TObject);
begin
   OpenFile(Sender,'');
end;

//保存文件
procedure TMainForm.M_SaveClick(Sender: TObject);
begin
   SaveFile(Sender,0);
end;

//另保为
procedure TMainForm.M_SaveAsClick(Sender: TObject);
begin
   SaveFile(Sender,1);
end;

//打印设置
procedure TMainForm.M_PrintPageClick(Sender: TObject);
begin
   try
     PrinterSetupDialog.Execute
   except
     Application.MessageBox(Pchar('无法找到默认的打印机'+NewLine+'请确认打印机已安装正确。'),Pchar(Application.Title),MB_ICONINFORMATION);
   end;
end;

//打印
procedure TMainForm.M_PrintClick(Sender: TObject);
begin
   try
     RichEdit1.Print(FileName);
   except
     Application.MessageBox(Pchar('无法找到默认的打印机'+NewLine+'请确认打印机已安装正确。'),Pchar(Application.Title),MB_ICONINFORMATION);
   end;
end;

//退出
procedure TMainForm.M_ExitClick(Sender: TObject);
begin
   Close;
end;

//撤消
procedure TMainForm.M_ZClick(Sender: TObject);
begin
   RichEdit1.Undo;
end;

//剪切
procedure TMainForm.M_CutClick(Sender: TObject);
begin
   RichEdit1.CutToClipboard;
end;

//复制
procedure TMainForm.M_CopyClick(Sender: TObject);
begin
   RichEdit1.CopyToClipboard;
end;

//粘贴
procedure TMainForm.M_PClick(Sender: TObject);
begin
   RichEdit1.PasteFromClipboard;
end;

//删除
procedure TMainForm.M_DelClick(Sender: TObject);
begin
   RichEdit1.ClearSelection;
end;

//全选
procedure TMainForm.M_CtrlAClick(Sender: TObject);
begin
   RichEdit1.SelectAll;
end;

//查找窗体
procedure TMainForm.M_FindClick(Sender: TObject);
begin
   with FindDialog do
   begin
     Position:=Point(Self.Left + Self.Width div 4,Self.Top + Self.Height div 4);
     FindText:=RichEdit1.SelText;
     Execute;
   end;
end;

//查找窗体中的查找功能
procedure TMainForm.FindDialogFind(Sender: TObject);
var
   SearchType:TSearchTypes;
begin
   with FindDialog do
   begin
     if frMatchCase in Options then
       SearchType:=SearchType+[stMatchCase];
     if frWholeWord in Options then
       SearchType:=SearchType+[stWholeWord];
     PerformFind(Sender,FindText,SearchType);
   end;
   RichEdit1.SetFocus;
   SendMessage(RichEdit1.Handle,EM_SCROLLCARET,0,0);
end;

//查找下一个
procedure TMainForm.M_FindNextClick(Sender: TObject);
begin
   if Length(FindDialog.FindText)>0 then
     FindDialogFind(Sender)
   else
     with FindDialog do
     begin
       Position:=Point(Self.Left + Self.Width div 4,Self.Top + Self.Height div 4);
       FindText:=RichEdit1.SelText;
       Execute;
     end;
end;

//替换窗体
procedure TMainForm.M_ReplaceClick(Sender: TObject);
begin
   with ReplaceDialog do
   begin
     Position:= Point(Self.Left + Self.Width div 4,Self.Top + Self.Height div 4);
     if RichEdit1.SelLength>0 then
     begin
       FindText:=RichEdit1.SelText;
       FindDialog.FindText:=RichEdit1.SelText;
     end
     else
       if Length(FindDialog.FindText)>0 then
         FindText:= FindDialog.FindText;
     Execute;   
   end;
end;

//替换中的查找功能
procedure TMainForm.ReplaceDialogFind(Sender: TObject);
var
   SearchType:TSearchTypes;
begin
   with ReplaceDialog do
   begin
     if frMatchCase in Options then
       SearchType:=SearchType+[stMatchCase];
     if frWholeWord in Options then
       SearchType:=SearchType+[stWholeWord];
     PerformFind(Sender,FindText,SearchType);
   end;
   RichEdit1.SetFocus;
   SendMessage(RichEdit1.Handle,EM_SCROLLCARET,0,0);
end;

//替换中的替换 替换全部功能
procedure TMainForm.ReplaceDialogReplace(Sender: TObject);
var
   SearchType:TSearchTypes;
   FoundAt, StartPos, ToEnd: Integer;
   str:string;
   label Start, Start1, Start2;
begin
   with ReplaceDialog do
   begin //1
 
     if frReplace in Options then
     begin//2
       if frMatchCase in Options then
         SearchType:=SearchType+[stMatchCase];
       if frWholeWord in Options then
         SearchType:=SearchType+[stWholeWord];

       if RichEdit1.Seltext = ReplaceDialog.FindText then
       begin
         RichEdit1.SelText:= ReplaceDialog.ReplaceText;
         Start1: StartPos:=RichEdit1.SelStart+RichEdit1.SelLength;
         ToEnd:= RichEdit1.GetTextLen-StartPos;
         FoundAt := RichEdit1.FindText(ReplaceDialog.FindText,StartPos,ToEnd,SearchType);

         if FoundAt<>-1 then
         begin
           RichEdit1.SelStart:=FoundAt;
           RichEdit1.SelLength:=Length(ReplaceDialog.FindText);
           if RichEdit1.Seltext='' then
           begin
           RichEdit1.Selstart:=RichEdit1.Selstart+2;
           goto Start1;
           end;
           SendMessage(RichEdit1.Handle, EM_SCROLLCARET, 0, 0);
         end
         else
         begin
           Str:= '找不到 '''''+ReplaceDialog.FindText+'''''';
           Application.MessageBox(PChar(Str),'记事本',MB_ICONINFORMATION);
         end;

       end
       else
       begin
         Start2: StartPos:=RichEdit1.SelStart+RichEdit1.SelLength;
         ToEnd:= RichEdit1.GetTextLen-StartPos;
         FoundAt := RichEdit1.FindText(ReplaceDialog.FindText,StartPos,ToEnd,SearchType);

         if FoundAt<>-1 then
         begin
           RichEdit1.SelStart:=FoundAt;
           if RichEdit1.Seltext='' then
           RichEdit1.SelLength:=Length(ReplaceDialog.FindText);
           begin
           RichEdit1.Selstart:=RichEdit1.Selstart+2; 
           goto Start2;
           end;
           SendMessage(RichEdit1.Handle, EM_SCROLLCARET, 0, 0);
         end
         else
         begin
           Str:= '找不到 '''''+ReplaceDialog.FindText+'''''';
           Application.MessageBox(PChar(Str),'记事本',MB_ICONINFORMATION);
         end;
       end;
     end;

     if frReplaceAll in Options then
     begin
       if frMatchCase in Options then
         SearchType:=SearchType+[stMatchCase];
       if frWholeWord in Options then
         SearchType:=SearchType+[stWholeWord];
       if RichEdit1.Seltext = ReplaceDialog.FindText then
         RichEdit1.SelText:= ReplaceDialog.ReplaceText;
       FindTextOld:='';
       PerformFind(Sender,FindText,SearchType);

       while PerformFind(Sender,FindText,SearchType) do
       begin
         RichEdit1.SelText:= ReplaceDialog.ReplaceText;
       end;
     end;

   end;//1
   RichEdit1.SetFocus;
   SendMessage(RichEdit1.Handle,EM_SCROLLCARET,0,0);
end;

//插入时间\日期
procedure TMainForm.M_DateTimeClick(Sender: TObject);
begin
   RichEdit1.SelText:=DatetimeToStr(now());
end;

//字体
procedure TMainForm.M_FontClick(Sender: TObject);
begin
   if FontDialog1.Execute then
   begin
     RichEdit1.Font:= FontDialog1.Font;
   end;
end;

//自动换行
procedure TMainForm.M_AutoLinesClick(Sender: TObject);
var
   Pos:Integer;
begin
   with RichEdit1,M_AutoLines do
   begin
     Pos:=SelStart;
     Checked:=Not Checked;
     WordWrap:=Checked;
     if WordWrap then
       ScrollBars:=ssVertical
     else
       ScrollBars:=ssBoth;
     SelStart:=Pos;
   end;
end;

//设置
procedure TMainForm.M_SetFrmClick(Sender: TObject);
begin
   SetForm:= TSetForm.Create(nil);
   SetForm.ShowModal;
end;

//替换平台
procedure TMainForm.M_ChageFrmClick(Sender: TObject);
begin
   //
end;

//帮助
procedure TMainForm.M_HelpClick(Sender: TObject);
var
   windir: Array[0..255] of char;
   tepstr: string;
begin
   GetSystemDirectory ( windir,SizeOf(windir));
   tepstr:= windir;
   Delete(tepstr, Length(tepstr)-7, 8);
   ShellExecute(Handle, 'open', PChar(tepstr+'\Help\notepad.chm'), nil, nil, SW_SHOW);
end;

//关于
procedure TMainForm.M_AboutClick(Sender: TObject);
begin
   ShellAbout(self.Handle,
     pChar('文本替换软件 '+GetFileVersion(ExtractFilePath(Application.Exename)+'\TextChange.exe')),
     pChar('作者:陈   宏     E-Mail:[email protected]'), HICON(nil));
end; 
//----------end----------//
//**********//

end.


学习中请遵守法律法规,本网站内容均来自于互联网,本网站不负担法律责任
标准 记事本 D el ph i 源码
#1楼
发帖时间:2016-7-9   |   查看数:0   |   回复数:0
游客组