main.pas

说明: 呵,这几天有点闲,把以前作过的模块拿来作成了这个小东西.主要是以前听说有软件实现这个功能,再加上当时自己需要,所以写下的.功能很小.代码也很短. 声明: 本代码,属免费源代码.可用

{********************************************************
***
***                        破天惊工作室
***  名称:网文快抓
***  日期:6.23.2004
***  环境:Delphi6+WinXP
***  作者:破天惊                                        
***  E-Mail:[e-mail]
***  最近比较闲,把以前"冷香小助"里的一个dll重新写了一遍.功能很小.                          
***
*********************************************************}
unit main;

interface

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

type
  Tfrmcopytext = class(TForm)
    edttitle: TEdit;
    lbltitle: TLabel;
    chbstart: TCheckBox;
    chbgetname: TCheckBox;
    mmomain: TMemo;
    lbltext: TLabel;
    procedure chbstartClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure chbgetnameClick(Sender: TObject);
    procedure getfilename;
    procedure savefile;
  private
    procedure gettext(var amessage:tmessage);message wm_drawclipboard;
  public
    { Public declarations }
  end;

var
  frmcopytext: Tfrmcopytext;
  tmptext:string;
  gt,ag:boolean;
  nextcliphwnd:hwnd;

implementation

{$R *.dfm}


//监视剪贴板内容
procedure tfrmcopytext.gettext(var amessage:tmessage);
begin
  sendmessage(nextcliphwnd,amessage.Msg,amessage.WParam,amessage.LParam);
  if gt then
    if (clipboard.HasFormat(cf_text)) or (clipboard.HasFormat(cf_oemtext)) then
    begin           //如果是文本内容则进行相应的操作;
      mmomain.Clear;
      mmomain.PasteFromClipboard;
      if ag then
        getfilename;
      savefile;
    end;
end;


//取名;
procedure tfrmcopytext.getfilename;
var
  schar,rchar:string;
  tmpnum:integer;
begin
  schar:=mmomain.Text;
  if length(schar)<21 then
    rchar:=schar
  else
  begin
    tmpnum:=1;
    rchar:='';
    while tmpnum<21 do
    begin
      if (schar[tmpnum] in ['/','\',':','*','?','<','>','|',' '])=false then
        rchar:=rchar+schar[tmpnum];
      inc(tmpnum);
    end;
  end;
  edttitle.Text:=rchar;
end;

//保存文件;
procedure tfrmcopytext.savefile;
var
  filetitle,filepath:string;
  titleinc:integer;
begin
  if (mmomain.text='') or (tmptext=mmomain.text) then
    exit;       //如果内容为空,或是与上次的内容相同则退出;
  titleinc:=0;
  filetitle:=trim(edttitle.Text);
  if filetitle='' then
    filetitle:='未名命';
  filepath:=extractfilepath(paramstr(0))+filetitle+'.txt';
  while fileexists(filepath) do
  begin
    inc(titleinc);
    filepath:=extractfilepath(paramstr(0))+filetitle+inttostr(titleinc)+'.txt';
  end;
  mmomain.Lines.SaveToFile(filepath);
  tmptext:=mmomain.text;
end;

procedure Tfrmcopytext.chbstartClick(Sender: TObject);
begin
  gt:=chbstart.Checked;
end;

procedure Tfrmcopytext.FormCreate(Sender: TObject);
begin
  ag:=true;
  gt:=true;
  tmptext:='';
  nextcliphwnd:=setclipboardviewer(frmcopytext.handle);
end;

procedure Tfrmcopytext.FormDestroy(Sender: TObject);
begin
  changeclipboardchain(handle,nextcliphwnd);
  sendmessage(nextcliphwnd,wm_changecbchain,handle,nextcliphwnd);
end;

procedure Tfrmcopytext.chbgetnameClick(Sender: TObject);
begin
  ag:=chbgetname.Checked;
end;

end.