//{{{{{{{{{{拖动打开文件{{{{{{{{{{// 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[i] 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));
//**********窗体创建与关闭**********// //----------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----------// //**********//
//新建文件 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_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;
//插入时间\日期 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;