捐赠 | 广告 | 注册 | 发布 | 上传 | 关于我们    
  粤ICP备10103342号-1 DELPHI盒子 | 盒子文章 | 盒子问答悬赏 | 最新更新 | 盒子检索 | 下载中心 | 高级搜索    
  精品专区 | 繁體中文 | 奖励公告栏 | 直通车账号登陆 | 关闭GOOGLE广告 | 临时留言    
盒子资源分类
全部展开 - 全部合拢
TextChange 记事本 (与Windows记事本相似)
关键字:TextChange 记事本 拖放 替换 全部替换 按扩展名打开文件
来 自:原创
平 台:Win9x,Win2k/XP/NT,Win2003 下载所需:0 火柴
深浅度:中级 完成时间:2006/8/8
发布者:hong9906 发布时间:2006/8/10
编辑器:DELPHI7 语  种:简体中文
分 类:应用软件 下载浏览:1931/18948
加入到我的收藏
下载错误报错
登陆以后才能下载
 用户名:
 密 码:
自动登陆(30天有效)
图片如果打不开,说明流量不够了,请稍候下载……
有个朋友要学Delphi看他写的代码我就来气,这是我写了一个规范记事本大家看看。记事本,可以拖放打开文件,也可以通过“选择程序”打开文件、替换、全部替换;全部代码都有,与Windows记事本很像。代码是按一定的规范写的,大家写程序要有这样的习惯才行。

下面贴出全部代码,供不下载的朋友看看:

  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[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));

      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:hong9906@163.com'), HICON(nil));
end;   
//----------end----------//
//**********//

end.
Google
 
本站原创作品,未经作者许可,严禁任何方式转载;转载作品,如果侵犯了您的权益,请联系我们
龙脉加密锁 15元起 Grid++Report 报表 申请支付@网
 相关文章
TextChange 记事本 (与Windows记事本相似)
hong9906 2006/8/10 下+1931/浏+18949 评+9
Notepad2003 记事本
shewo 2004/2/13 下+1976/浏+14355 评+7
Word2me 1.0.0 Build <记事本>
yfeng 2003/9/27 下+1222/浏+12804 评+6
相关评论
共有评论9条
我要发表评论 查看全部评论
 
  DELPHI盒子版权所有 技术支持:深圳市麟瑞科技有限公司 1999-2024 V4.01 粤ICP备10103342号-1 更新RSS列表