Unit1.pas

unit Unit1;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes,
  System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Memo.Types,
  FMX.Controls.Presentation, FMX.ScrollBox, FMX.Memo, FMX.Layouts, FMX.StdCtrls,
  System.IOUtils, FMX.Objects, FMX.Ani, FMX.Effects, System.DateUtils, Posix.Unistd;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    Filedelete: TButton;
    FileExit: TButton;
    FileNew: TButton;
    FileOpen: TButton;
    FileSave: TButton;
    FileSaveAs: TButton;
    Label1: TLabel;
    Image1: TImage;

    procedure FileNewClick(Sender: TObject);
    procedure FileOpenClick(Sender: TObject);
    procedure FileSaveClick(Sender: TObject);
    procedure FileSaveAsClick(Sender: TObject);
    procedure FileExitClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Memo1MouseLeave(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FiledeleteMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Single);
    procedure FiledeleteMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Single);
    procedure Memo1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Single);

  private
    { Private declarations }

    procedure ToastConfirm(const AStr: string);
    procedure AniToastFinish(Ani: TObject);
    procedure SetFileName(const FileName: String);
    procedure ResultProc(AResult: Boolean; AFileName: string); // 打开参数过程
    procedure ResultProc1(AResult: Boolean; AFileName: string); // 另存参数过程

  public
    { Public declarations }
    procedure Button_A_Click(Sender: TObject);
    procedure Button_B_Click(Sender: TObject);
  end;

var
  Form1: TForm1;
  FFileName: string;
  FWantExit: Boolean;
  Label_A,Label_B:Tlabel;
  Button_A,Button_B:Tbutton;
function GetTextType(const FileName: string): String;

implementation

uses
{$IFDEF ANDROID}
{$ENDIF}
  MyDialogs;

type
  TTextFormat = (tfAnsi, tfUnicode, tfUnicodeBigEndian, tfUtf8);

var
  today: Cardinal;
  selstart: integer;
  sellength: integer;

const
  // TextFormatFlag: array[tfAnsi..tfUtf8] of word=($0000,$FFFE,$FEFF,$EFBB);
  TextFormatFlag: array [tfAnsi .. tfUtf8] of word = ($0000, $FEFF, $FFFE,
    $BBEF); // 编码标志高低字节互换

{$R *.fmx}
{$R *.LgXhdpiPh.fmx ANDROID}

resourcestring
  sSaveChanges = '是否将未更改保存到 %s?';
  sOverWrite = '%s 已存在。' + #13#10 + '要替换它吗？';
  sTitle = '记事本';
  sUntitled = '未命名';
  sColRowInfo = 'Line: %3d   Col: %3d';
  sCommonDlgFileName = '文本文档(*.txt)|*.txt|所有文件(*.*)|*.*';

procedure TForm1.SetFileName(const FileName: String);
begin
  FFileName := System.IOUtils.Tpath.GetSharedDocumentsPath + '/' +
    FileName + '.txt';
  Caption := Format('%s - %s', [ExtractFileName(FileName), sTitle]);
end;

procedure TForm1.ResultProc(AResult: Boolean; AFileName: string); // 默认参数过程，打开用到
var
  reader: TStreamReader;
  TextEncode, s, s1: string;
begin
  if AResult then
  begin

    TextEncode := GetTextType(AFileName); // 获取文件编码类型
    // showmessage(TextEncode);

    if TextEncode = 'ANSI' then // 注意：字符串比较大小写敏感！
      reader := TStreamReader.Create(AFileName, TEncoding.ansi)
    else if TextEncode = 'Utf8' then
      reader := TStreamReader.Create(AFileName, TEncoding.utf8)
    else if TextEncode = 'Unicode' then
      reader := TStreamReader.Create(AFileName, TEncoding.unicode)
    else
      reader := TStreamReader.Create(AFileName, TEncoding.BigEndianUnicode);

    Memo1.Lines.clear; // 清空Memo1中原有内容

    while not reader.EndOfStream do
    begin
      Memo1.Lines.Add(reader.ReadLine);
    end;

    reader.Free;
    s := copy(AFileName, pos('Documents/', AFileName) + 10, 50); // 取文件名（不带路径）
    s1 := copy(s, pos('.', s) + 1, 5); // 取扩展名
    Label1.text := '当前文件：' + s;

    Button1.text := '选择'; // 加入选择当前行功能

    Memo1.selstart := 0; // 光标放最前面
  end;
end;

procedure TForm1.ResultProc1(AResult: Boolean; AFileName: string);
// 默认参数过程1，另存用到
var
  s: string;
begin

  if AResult then
  begin
    Memo1.Lines.SaveToFile(AFileName);
    s := copy(AFileName, pos('Documents/', AFileName) + 10, 50); // 取文件名（不带路径）
    Label1.text := '当前文件：' + s;
  end;
end;

procedure TForm1.FileNewClick(Sender: TObject); // 新建
begin

  SetFileName(sUntitled);
  Label1.text := '当前文件：' + sUntitled + '.txt';
  Memo1.Lines.clear;
  Memo1.text := '';
end;

procedure TForm1.FileOpenClick(Sender: TObject); // 打开
begin

  GetFileOpenDialog(ResultProc);
  {
    case TComponent(Sender).Tag of
    1: GetFileOpenDialog(ResultProc);
    2: GetFileSaveDialog(ResultProc);
    3: GetSelectDirectoryDialog(ResultProc);
    end;
  }

end;

procedure TForm1.FileSaveClick(Sender: TObject); // 保存
  var
    s: string;
begin

  s := copy(FFileName, pos('Documents/', FFileName) + 10, 50);
  if s = '.txt' then
    FileSaveAsClick(Sender)
  else
  begin
    showmessage('当前保存位置及文件名：' + FFileName);
    Memo1.Lines.SaveToFile(FFileName);
    // Memo1.text := '';
  end;
end;

procedure TForm1.FileSaveAsClick(Sender: TObject); // 另存
begin
  GetFileSaveDialog(ResultProc1); // 调用通用对话框
end;

procedure TForm1.Button1Click(Sender: TObject); // 选择当前行文本（或调试运行html）
var
  Line: integer;
begin

  Memo1.setfocus;
  with Memo1 do
  begin
    Line := CaretPosition.Line;
    selstart := selstart - CaretPosition.pos;
    if Lines.count > 0 then
      sellength := Length(Lines[Line]); // 如不是空文件，选择当前行
  end;

end;

procedure TForm1.FiledeleteMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Single);

begin
  today := MilliSecondOfTheDay(Now);
end;

procedure TForm1.FiledeleteMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Single);
var
  today1: Cardinal;
begin
  today1 := MilliSecondOfTheDay(Now) - today;
  if today1 > 2000 then
  begin
    if Label1.text <> '当前文件：未命名.txt' then
    begin
      showmessage('已删除' + Label1.text);
      deletefile(FFileName);
    end;

    SetFileName(sUntitled);
    Label1.text := '当前文件：' + sUntitled + '.txt';
    Memo1.Lines.clear;
    Memo1.text := '';
  end
  else
    showmessage('确认删除文件请长按此按钮！');
end;

procedure TForm1.FileExitClick(Sender: TObject); // 退出
begin
  Close;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); // 按两次退出
begin
{$IFDEF ANDROID}
  if not FWantExit then
  begin
    ToastConfirm('再按一次退出程序.');
    Action := TCloseAction.caNone;
  end
  else
  begin
    Label_A.free;
    Label_B.free;
    Button_A.free;
    Button_B.free;
    Memo1.height := 510; // 将meno控件恢复到默认高度
    Memo1.Lines.clear;
  end;
  FWantExit := True;

{$ENDIF}
end;

procedure TForm1.FormShow(Sender: TObject); // form1显示
begin

  SetFileName(sUntitled);
  Label1.text := '当前文件：' + sUntitled + '.txt';
  //Memo1.height := 436;

end;

procedure TForm1.Button_A_Click(Sender: TObject); //光标回首行
begin
  Form1.Memo1.selstart := 0;
end;

procedure TForm1.Button_B_Click(Sender: TObject); //光标到末行
begin
  Form1.Memo1.selstart := Form1.Memo1.text.length;
end;

procedure TForm1.Memo1MouseLeave(Sender: TObject); // 改变memo1高度以适应虚拟键盘
var
  i: integer;
const
  halfscreen :integer = 403;  //显示输入法界面后的memo高度

begin
  i := Memo1.selstart;
  // showmessage(inttostr(i));

  if (i>0) and (Memo1.height > 430) then
  begin
    Memo1.height := halfscreen;
    Memo1.selstart := i;

    //创建显示行、列号标签
      Label_A := tlabel.Create(Self);
      with Label_A do
      begin
        Parent := Self;
        position.x := 6;
        position.y := halfscreen+30;
        //Text := '行号：'+IntToStr(Memo1.CaretPosition.line); // 显示行号
        Width := 165;
        Height := 20;
        Visible := true;
      end;

      Label_B := tlabel.Create(Self);
      with Label_B do
      begin
        Parent := Self;
        position.x := 230;
        position.y := halfscreen+30;
        //Text := '列号：'+IntToStr(Memo1.CaretPosition.Pos); // 显示列号
        Width := 165;
        Height := 20;
        Visible := true;
      end;

      //创建滚动条加速按钮

      Button_A := tButton.Create(Self);
      with Button_A do
      begin
        Parent := Self;
        position.x := 135;
        position.y := halfscreen+30;
        Text := '|←';
        Width := 32;
        Height := 20;
        Visible := true;
        onclick := Button_A_Click;  //设置点击事件
      end;

      Button_B := tButton.Create(Self);
      with Button_B do
      begin
        Parent := Self;
        position.x := 193;
        position.y := halfscreen+30;
        Text := '→|';
        Width := 32;
        Height := 20;
        Visible := true;
        onclick := Button_B_Click;  //设置点击事件
      end;

  end;

  if Memo1.height = halfscreen then   //动态更新行列号
  begin
      Label_A.Text := '当前行号：'+IntToStr(Memo1.CaretPosition.line+1);
      Label_B.Text := '当前列号：'+IntToStr(Memo1.CaretPosition.Pos+1);
  end;

  if (Memo1.selstart = selstart) and (Memo1.sellength = sellength) then
    Memo1.enabledscroll := false; // 选择区域未发生变化，禁止滚动

end;


procedure TForm1.Memo1MouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Single); // 控制memo1选择文本时不滚动

begin
  selstart := Memo1.selstart;
  sellength := Memo1.sellength;

  if (Memo1.sellength < 50) and (Memo1.sellength > 0) then
    Memo1.enabledscroll := false
  else
    Memo1.enabledscroll := True;

end;

function WordLoHiExchange(w: word): word; // 高低位互换
var
  hi: word;
  lo: word;

begin
  hi := w shl 8;
  lo := w shr 8;
  result := hi or lo
end;

function GetTextType(const FileName: string): String; // 获取编码类型
var
  w: word;
begin
  with TFileStream.Create(FileName, fmOpenRead or fmShareDenyNone) do
    try
      Read(w, 2);
      // w:=WordLoHiExchange(w);//因为是以Word数据类型读取，故高低字节互换
      // ShowMessage(IntToStr(w));  //查看word变量值
      if w = TextFormatFlag[tfUnicode] then
        result := 'Unicode'
      else if w = TextFormatFlag[tfUnicodeBigEndian] then
        result := 'UnicodeBigEndian'
      else if w = TextFormatFlag[tfUtf8] then
        result := 'Utf8'
      else
        result := 'ANSI';
    finally
      Free;
    end;
end;

procedure TForm1.AniToastFinish(Ani: TObject); // 按两次退出提示框结束
begin
  with TFloatAnimation(Ani) do
  begin
    Delay := 2;
    Duration := 0.3;
    Inverse := True;
    if (TControl(Parent).Opacity = 1) then
      FMX.Ani.TAnimator.StartAnimation(Parent, 'Ani')
    else
      FWantExit := not Inverse;
  end;
end;

procedure TForm1.ToastConfirm(const AStr: string); // 按两次退出提示框

  procedure AniInit(A: TFloatAnimation); // 内部过程
  begin
    with A do
    begin
      Parent := TFmxObject(Owner);
      Name := 'Ani';
      PropertyName := 'Opacity';
      StartValue := 0;
      StopValue := 1;
      Delay := 0;
      Duration := 0;
      Inverse := false;
      OnFinish := AniToastFinish;
      Start;
    end;
  end;

  function Find(ACName: string; ACClass: TComponentClass; AOwner: TComponent)
    : TObject; // 内部函数
  begin
    result := AOwner.FindComponent(ACName);
    if not Assigned(result) then
      result := ACClass.Create(AOwner);
  end;

var
  LR: TRectangle;
begin
  LR := TRectangle(Find('Toast', TRectangle, Self));
  with LR do
  begin
    if (Name = '') then
    begin
      Name := 'Toast';
      XRadius := 1;
      YRadius := 1;
      Stroke.Kind := TBrushKind.None;
      Fill.Color := TAlphaColorRec.Black;
      HitTest := false;

      with TGlowEffect.Create(LR) do
      begin
        Parent := LR;
        GlowColor := TAlphaColorRec.Black;
      end;

      with TText.Create(LR) do
      begin
        Name := 'ShowText';
        Parent := LR;
        Font.Size := 12;
        Align := TAlignLayout.Client;
        Color := TAlphaColorRec.White;
      end;
      Parent := Self;
    end;

    with TText(LR.FindComponent('ShowText')) do
    begin
      text := AStr;
      LR.Width := Canvas.TextWidth(AStr) + 35;
      LR.height := Canvas.TextHeight(AStr) + 16;
    end;

    LR.Position.X := (Self.Width - LR.Width) / 2;
    LR.Position.Y := (Self.height - LR.height) / 1.25;
    LR.Repaint;
    LR.BringToFront;
    AniInit(TFloatAnimation(Find('Ani', TFloatAnimation, LR)));
  end;

end;

end.