鱼C论坛

 找回密码
 立即注册
查看: 3286|回复: 4

记事本一输入内容就自动插入日期而且是一直插入,直到满了。

[复制链接]
发表于 2014-8-4 08:03:42 | 显示全部楼层 |阅读模式
1鱼币
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Menus,ShellAPI;

type
  TForm1 = class(TForm)
    mm1: TMainMenu;
    film1: TMenuItem;
    New1: TMenuItem;
    Open1: TMenuItem;
    Save1: TMenuItem;
    N1: TMenuItem;
    Exit1: TMenuItem;
    edit1: TMenuItem;
    Undo1: TMenuItem;
    N2: TMenuItem;
    Copy1: TMenuItem;
    Paste1: TMenuItem;
    Cut1: TMenuItem;
    Delete1: TMenuItem;
    N3: TMenuItem;
    All1: TMenuItem;
    N4: TMenuItem;
    Find1: TMenuItem;
    Replace1: TMenuItem;
    N5: TMenuItem;
    Datetime1: TMenuItem;
    O1: TMenuItem;
    Font1: TMenuItem;
    BackGround1: TMenuItem;
    Help1: TMenuItem;
    About1: TMenuItem;
    mmo1: TMemo;
    dlgOpen1: TOpenDialog;
    dlgSave1: TSaveDialog;
    dlgFind1: TFindDialog;
    dlgReplace1: TReplaceDialog;
    dlgFont1: TFontDialog;
    dlgColor1: TColorDialog;
    procedure Open1Click(Sender: TObject);
    procedure Save1Click(Sender: TObject);
    procedure Undo1Click(Sender: TObject);
    procedure Cut1Click(Sender: TObject);
    procedure Copy1Click(Sender: TObject);
    procedure Paste1Click(Sender: TObject);
    procedure Delete1Click(Sender: TObject);
    procedure All1Click(Sender: TObject);
    procedure Datetime1Click(Sender: TObject);
    procedure Font1Click(Sender: TObject);
    procedure BackGround1Click(Sender: TObject);
    procedure About1Click(Sender: TObject);
    procedure Find1Click(Sender: TObject);
    procedure dlgFind1Find(Sender: TObject);
    procedure Replace1Click(Sender: TObject);
    procedure dlgReplace1Replace(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
var
  FileName:String;
procedure TForm1.Open1Click(Sender: TObject);
begin
    dlgOpen1.filter :='文本文档(*.txt)|*.TXT';


   if  dlgOpen1.Execute then
   begin
     FileName:=dlgOpen1.FileName;
     mmo1.Lines.LoadFromFile(FileName);
   end
   else
      Exit;
end;

procedure TForm1.Save1Click(Sender: TObject);
begin
      dlgSave1.Filter:= '文本文档(*.txt)|*.TXT';

      if dlgSave1.Execute then
      begin
        FileName:= dlgSave1.FileName+'.txt';
        mmo1.Lines.SaveToFile(FileName);
      end;
end;

procedure TForm1.Undo1Click(Sender: TObject);
begin
    mmo1.Undo;
end;

procedure TForm1.Cut1Click(Sender: TObject);
begin
   mmo1.CutToClipboard;
end;

procedure TForm1.Copy1Click(Sender: TObject);
begin
      mmo1.CopyToClipboard;
end;

procedure TForm1.Paste1Click(Sender: TObject);
begin
      mmo1.PasteFromClipboard;
end;

procedure TForm1.Delete1Click(Sender: TObject);
begin
   mmo1.ClearSelection;
end;

procedure TForm1.All1Click(Sender: TObject);
begin
      mmo1.SelectAll;
end;

procedure TForm1.Datetime1Click(Sender: TObject);
begin
   mmo1.SelText:= DateTimeToStr(Now());
end;

procedure TForm1.Font1Click(Sender: TObject);
begin
      if dlgFont1.Execute then
        mmo1.Font:=dlgFont1.Font
      else
        Exit;
end;

procedure TForm1.BackGround1Click(Sender: TObject);
begin
      if dlgColor1.Execute then
        mmo1.Color:=dlgColor1.Color
      else
        Exit;
end;

procedure TForm1.About1Click(Sender: TObject);
begin
    ShellAbout(Self.Handle,
        PChar('鱼c编程日记本 V1.0'),
        PChar('制作人: so、so'),
        HICON(nil));
end;

procedure TForm1.Find1Click(Sender: TObject);
begin
      dlgFind1.FindText:=mmo1.SelText;
      dlgFind1.Execute;
end;

procedure TForm1.dlgFind1Find(Sender: TObject);
var
  i,j, PosReturn,SkipChars: Integer;

begin
  for i:=0 to mmo1.Lines.Count do
    begin
      PosReturn:= Pos(dlgFind1.FindText,mmo1.Lines[i]);
      if PosReturn <> 0 then
      begin
        SkipChars:=0;
        for j:=0 to i-1 do
        SkipChars:= SkipChars + Length(mmo1.Lines[j]);
        SkipChars:= SkipChars + (i*2);
        SkipChars:= SkipChars + PosReturn - 1;

        mmo1.SetFocus;
        mmo1.SelStart:= SkipChars;
        mmo1.SelLength:=Length(dlgFind1.FindText);
        Break;
      end;
    end;

end;

procedure TForm1.Replace1Click(Sender: TObject);
begin
    dlgReplace1.ReplaceText:=mmo1.SelText;
    dlgReplace1.Execute;
end;

procedure TForm1.dlgReplace1Replace(Sender: TObject);
var
      SelPos:Integer;
begin
    with TReplaceDialog(Sender) do
    begin
      SelPos := Pos(FindText,mmo1.Lines.Text);
      if SelPos > 0 then
      begin
         mmo1.SelStart := SelPos - 1;
         mmo1.SelLength:= Length(FindText);
         mmo1.SelText := ReplaceText;
      end
      else
        MessageBox(0,'抱歉找不到需要替换的文件!','通知',MB_OK or MB_ICONWARNING);
    end;
end;

end.
发不了图、、、

想知道小甲鱼最近在做啥?请访问 -> ilovefishc.com
回复

使用道具 举报

发表于 2014-8-4 10:18:00 | 显示全部楼层
不会delphi
想知道小甲鱼最近在做啥?请访问 -> ilovefishc.com
回复

使用道具 举报

 楼主| 发表于 2014-8-4 10:32:06 | 显示全部楼层
想知道小甲鱼最近在做啥?请访问 -> ilovefishc.com
回复

使用道具 举报

发表于 2014-8-8 15:08:50 | 显示全部楼层
看看那
想知道小甲鱼最近在做啥?请访问 -> ilovefishc.com
回复

使用道具 举报

发表于 2014-9-7 12:44:17 | 显示全部楼层
谢谢,非常有帮助!
想知道小甲鱼最近在做啥?请访问 -> ilovefishc.com
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

小黑屋|手机版|Archiver|鱼C工作室 ( 粤ICP备18085999号-1 | 粤公网安备 44051102000585号)

GMT+8, 2024-11-23 01:35

Powered by Discuz! X3.4

© 2001-2023 Discuz! Team.

快速回复 返回顶部 返回列表