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.