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;

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

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


  private
    { Private declarations }

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


  public
    { Public declarations }

  end;

var
  Form1: TForm1;
  FFileName: string;
  FWantExit: Boolean;
  function GetTextType(const FileName: string): String;

implementation

uses
{$IFDEF ANDROID}
  FMX.Platform.Android,
{$ENDIF}
  MyDialogs;
type
  TTextFormat=(tfAnsi, tfUnicode, tfUnicodeBigEndian, tfUtf8);
var
  today : Cardinal;

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.PerformFileOpen(const AFileName: string);
begin
  Memo1.Lines.LoadFromFile(AFileName);
  SetFileName(AFileName);
  Memo1.SetFocus;
  Memo1.text := '';
end;


procedure TForm1.ResultProc(AResult: Boolean; AFileName: string);     //默认参数过程，打开用到
var
  reader: TStreamReader;
  TextEncode,s: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);  //取文件名（不带路径）
    label1.text:='当前文件：'+s;
    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);        //保存
begin

  showmessage('当前保存位置及文件名：'+FFileName);

  if FFileName = sUntitled then
    FileSaveAsclick(sender)
  else
  begin
    Memo1.Lines.SaveToFile(FFileName);
    //Memo1.text := '';
  end;
end;

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

procedure TForm1.Button1Click(Sender: TObject);              //选择当前行文本内容
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
    Memo1.Lines.clear;

  FWantExit := True;

{$ENDIF}
end;


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

  SetFileName(sUntitled);
  label1.text:='当前文件：'+sUntitled+'.txt';
  memo1.height:= 473;  //将meno控件恢复到默认高度

end;



procedure TForm1.Memo1MouseLeave(Sender: TObject);     //改变memo1高度以适应虚拟键盘
var
  i: Integer;

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

  if (i>0)and(memo1.height>470) then
  begin
     memo1.height:=370;
     memo1.selstart:=i;
  end;

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;
  b: Byte;
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.