• Delphi Memo的记事本功能


    Delphi Memo的记事本功能

     

    这个代码实现了Windows记事本的主要功能。
    新建,打开,保存,另存,退出。
    文件拖拽打开文件 这主要是判断Memo内容是否修改过
    unit Unit1;
      
    interface
      
    uses
      Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
      System.Classes, Vcl.Graphics,
      Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtDlgs;
      
    type
      TForm1 = class(TForm)
        Memo1: TMemo;
        FileOpen: TButton;
        FileSave: TButton;
        FileSaveAs: TButton;
        FileExit: TButton;
        FileNew: TButton;
        OpenDialog1: TOpenDialog;
        SaveDialog1: TSaveDialog;
        procedure FileOpenClick(Sender: TObject);
        procedure FileSaveClick(Sender: TObject);
        procedure FileExitClick(Sender: TObject);
        procedure FormCreate(Sender: TObject);
        procedure FileNewClick(Sender: TObject);
        procedure FileSaveAsClick(Sender: TObject);
        procedure FormClose(Sender: TObject; var Action: TCloseAction);
      private
        { Private declarations }
        FFileName: string;
        FUpdating: Boolean;
        FDragOfs: Integer;
        FDragging: Boolean;
        procedure CheckFileSave;
        procedure SetFileName(const FileName: String);
        procedure PerformFileOpen(const AFileName: string);
        procedure WMDropFiles(var Msg: TWMDropFiles); message WM_DROPFILES;
      public
        { Public declarations }
      end;
      
    var
      Form1: TForm1;
      
    implementation
      
    uses ShellAPI;
    {$R *.dfm}
      
    resourcestring
      sSaveChanges = '是否将未更改保存到 %s?';
      sOverWrite = '%s 已存在。'+#13#10+'要替换它吗?';
      sTitle = '记事本';
      sUntitled = '未命名';
      sColRowInfo = 'Line: %3d   Col: %3d';
      sCommonDlgFileName = '文本文档(*.txt)|*.txt|所有文件(*.*)|*.*';
      
      
    procedure TForm1.CheckFileSave;
    var
      SaveRespond: Integer;
    begin
      if not Memo1.Modified then
        Exit;
      SaveRespond := MessageBox(Handle, PWideChar(Format(sSaveChanges, [FFileName])
        ), PWideChar(sTitle), MB_YESNOCANCEL + MB_ICONINFORMATION);
      case SaveRespond of
        idYes:
          FileSave.click;
        idNo:
          ; { Nothing }
        idCancel:
          Abort;
      end;
    end;
      
    procedure TForm1.SetFileName(const FileName: String);
    begin
      FFileName := FileName;
      Caption := Format('%s - %s', [ExtractFileName(FileName), sTitle]);
    end;
      
    procedure TForm1.PerformFileOpen(const AFileName: string);
    begin
      Memo1.Lines.LoadFromFile(AFileName);
      SetFileName(AFileName);
      Memo1.SetFocus;
      Memo1.Modified := False;
    end;
      
    procedure TForm1.WMDropFiles(var Msg: TWMDropFiles);
    var
      CFileName: array [0 .. MAX_PATH] of Char;
    begin
      try
        if DragQueryFile(Msg.Drop, 0, CFileName, MAX_PATH) > 0 then
        begin
          CheckFileSave;
          PerformFileOpen(CFileName);
          Msg.Result := 0;
        end;
      finally
        DragFinish(Msg.Drop);
      end;
    end;
      
    procedure TForm1.FileNewClick(Sender: TObject);
    begin
      CheckFileSave;
      SetFileName(sUntitled);
      
      Memo1.Lines.Clear;
      Memo1.Modified := False;
    end;
      
    procedure TForm1.FileOpenClick(Sender: TObject);
    begin
      CheckFileSave;
      
      with TOpenDialog.Create(nil) do
      begin
        Filter := sCommonDlgFileName;
        FileName:='*.txt';
        if Execute then
        begin
          PerformFileOpen(FileName);
          Memo1.ReadOnly := ofReadOnly in Options;
        end;
      end;
    end;
      
    procedure TForm1.FileSaveAsClick(Sender: TObject);
    begin
      with TSaveDialog.Create(nil) do
      begin
        Filter := sCommonDlgFileName;
        FileName:='*.txt';
        if Execute then
        begin
          if FileExists(FileName) then
            if MessageBox(Handle, PWideChar(Format(sOverWrite, [FFileName])),
              PWideChar(sTitle), MB_YESNOCANCEL + MB_ICONINFORMATION) <> idYes then
              Exit;
          Memo1.Lines.SaveToFile(FileName);
          SetFileName(FileName);
          Memo1.Modified := False;
        end;
      end;
    end;
      
    procedure TForm1.FileSaveClick(Sender: TObject);
    begin
      if FFileName = sUntitled then
        FileSaveAs.click
      else
      begin
        Memo1.Lines.SaveToFile(FFileName);
        Memo1.Modified := False;
      end;
    end;
      
    procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
    begin
      CheckFileSave;
    end;
      
    procedure TForm1.FormCreate(Sender: TObject);
    begin
      SetFileName(sUntitled);
      DragAcceptFiles(Handle, True);
    end;
      
    procedure TForm1.FileExitClick(Sender: TObject);
    begin
      Close;
    end;
      
    end.
  • 相关阅读:
    MFC中小笔记(四)
    MFC中小笔记(三)
    MFC中小笔记
    关于小蜘蛛诞生的坎坎坷坷
    Win32Api程序设计 常用域改变(设定)窗口位置、大小的api
    Win32Api程序设计 注册窗口类
    TCP segment of a reassembled PDU【转】
    计算机网络复习 -- 概念梳理
    指针(pointer) -- (上)
    原来我连真正的调试都不会,每次都是靠编译器(⊙﹏⊙)b
  • 原文地址:https://www.cnblogs.com/jijm123/p/10917625.html
Copyright © 2020-2023  润新知