unit1.pas

秘密阅读工具

{
程序编写：断剑
日期：2005-11-1
}

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, StdCtrls, ComCtrls, ExtCtrls, clipbrd, abfComponents;

type
  TForm1 = class(TForm)
    FontDialog1: TFontDialog;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    RichEdit1: TRichEdit;
    RichEdit2: TRichEdit;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N9: TMenuItem;
    N10: TMenuItem;
    Panel1: TPanel;
    N11: TMenuItem;
    Panel2: TPanel;
    N13: TMenuItem;
    N14: TMenuItem;
    N15: TMenuItem;
    N16: TMenuItem;
    abfTrayIcon1: TabfTrayIcon;
    mmo1: TMemo;
    u1: TMenuItem;
    N12: TMenuItem;
    N17: TMenuItem;
    N18: TMenuItem;
    N19: TMenuItem;
    N2: TMenuItem;
    N8: TMenuItem;
    N20: TMenuItem;
    N21: TMenuItem;
    dlgOpen1: TOpenDialog;
    dlgSave1: TSaveDialog;
    Timer1: TTimer;
    q1: TMenuItem;
    N22: TMenuItem;
    procedure N1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure RichEdit2KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure RichEdit1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure N3Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure N5Click(Sender: TObject);
    procedure N6Click(Sender: TObject);
    procedure N7Click(Sender: TObject);
    //procedure N8Click(Sender: TObject);
    procedure N9Click(Sender: TObject);
    procedure N10Click(Sender: TObject);
    procedure N11Click(Sender: TObject);
    procedure Panel2MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);

    procedure Panel2MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Panel2MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure N14Click(Sender: TObject);
    procedure N15Click(Sender: TObject);
    procedure N16Click(Sender: TObject);
    procedure RichEdit2MouseWheel(Sender: TObject; Shift: TShiftState;
      WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
    procedure RichEdit1MouseWheel(Sender: TObject; Shift: TShiftState;
      WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
    procedure u1Click(Sender: TObject);
    procedure N8Click(Sender: TObject);
    procedure N20Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure q1Click(Sender: TObject);
    procedure N22Click(Sender: TObject);
    procedure Panel2DblClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    FLock: Boolean;
    FStyle: Integer; //控制窗体有无边框
    FChange: Boolean;
    sBook: widestring;
    FGetClipTxt: Boolean; //是否监视剪贴板
    FDbl,FViewCap:boolean;
    procedure ChangeEdit;
    procedure WMNCHITTEST(var M: TWMNCHITTEST); message wm_nchittest;
    procedure SetBookMark(Sender: TObject);
    function BookStr: string;
    procedure SaveFile(FileName: string);
    procedure LoadFile(FileName: string);
    procedure RePlaceBmk;
    { Private declarations }
  public
    ColorValue: Integer;
    NextClipHwnd: HWND; //观察链中下一个窗口句柄
    procedure WMDrawClipBoard(var AMessage: TMessage);
      message WM_DRAWCLIPBOARD;
    //  procedure CreateParams(var Params: TCreateParams); override;
       { Public declarations }
  end;

var
  Form1: TForm1;
  dx, dy: Integer;
const BmkFlag = '书签888888';
implementation
uses   uColorForm;

function ShowInforMsg(InforStr: string; IncCancel: boolean = False): Integer;
var
  Buttons: Word;
begin
  if not IncCancel then
    Buttons := MB_OK + MB_ICONINFORMATION
  else
    Buttons := MB_OKCANCEL + MB_ICONINFORMATION;

  Result := application.MessageBox(PChar(InforStr), '提示', Buttons);
end;

function IsNumber(Value: string): boolean;
var
  V: Double;
  E: Integer;
begin
  Val(Value, V, E);
  Result := E = 0;
end;

procedure delay(second: real);
var
  i: real;
  t1, t2: Cardinal;
begin
  t1 := GetTickCount;
  i := 0;
  while i <= second * 1000 do
  begin
    t2 := GetTickCount;
    i := t2 - t1;
  end;
end;

{$R *.dfm}
//监视剪贴板
procedure TForm1.WMDrawClipBoard(var AMessage: TMessage);
begin
  //将WM_DRAWCLIPBOARD消息传递到下一个观察链中的窗口
  SendMessage(NextClipHwnd, AMessage.Msg,
    AMessage.WParam, AMessage.LParam);

  //查询剪贴板中特定格式的数据内容
  if (Clipboard.HasFormat(CF_TEXT) or
    Clipboard.HasFormat(CF_OEMTEXT)) then
  begin
    if FGetClipTxt then
    begin
      //处理剪贴板中内容
      with RichEdit1 do
      begin
        Lines.Add(Clipboard.asText);
        Lines.Add('');
        { if FIsFenGe then
           case FFenGeType of
             1: Lines.Add('');
             2: Lines.Add('-------------- ' + DateTimeToStr(Now));
           else

           end;   }
      end;

    end;
  end;

end;

procedure TForm1.WMNCHITTEST(var M: TWMNCHITTEST);
begin //可在窗口任意部分移動窗口
  inherited;
  if M.Result = htClient then
    M.Result := htCaption;
end;

procedure SetLine(RichEdit1: TRichEdit; LineNum: Integer);
var
  ScrollLn: Integer;
begin
  RichEdit1.SelStart := RichEdit1.Perform(EM_LINEINDEX, LineNum, 0);
  ScrollLn := LineNum - RichEdit1.Perform(EM_GETFIRSTVISIBLELINE, 0, 0);
  RichEdit1.Perform(EM_LINESCROLL, 0, ScrollLn);
end;

function SplitStr(SourceStr, Flag: string): TStringList;
var
  Atom: string;
  i, FlagLen: Integer;
begin
  Result := TStringList.Create;
  FlagLen := Length(Flag);

  i := Pos(Flag, SourceStr);
  while i > 0 do
  begin
    Atom := Copy(SourceStr, 1, i - 1);
    Result.Add(Atom);
    Delete(SourceStr, 1, i + FlagLen - 1);
    i := Pos(Flag, SourceStr);
  end;
  if SourceStr <> '' then Result.Add(SourceStr);
end;

procedure TForm1.N1Click(Sender: TObject);
begin
  if FontDialog1.Execute then
  begin
    with RichEdit1 do
    begin
      Font.Color := FontDialog1.Font.Color;
      Font.Size := FontDialog1.Font.Size;
      Font.Style := FontDialog1.Font.Style;
    end;
    with RichEdit2 do
    begin
      Font.Color := FontDialog1.Font.Color;
      Font.Size := FontDialog1.Font.Size;
      Font.Style := FontDialog1.Font.Style;
    end;

  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var s: Integer;
begin
  //获得观察链中下一个窗口句柄
  NextClipHwnd := SetClipboardViewer(Handle);

  RichEdit1.Font.Style := RichEdit1.Font.Style + [fsItalic];
  RichEdit1.Font.Size := 9;

  FStyle := 1;

  { s := -4;
   self.BorderWidth := s;

   SetWindowLong(Handle, GWL_STYLE, GetWindowLong(Handle, GWL_STYLE) and (not
     WS_CAPTION));
   Height := ClientHeight;
   Width := ClientWidth; }

  dx := 0;
  dy := 0;

  sBook := 'ǔǖǘǚǜ'; //书签
end;

procedure TForm1.ChangeEdit;
begin
  FChange := not FChange;
  if not FChange then
  begin
    // self.Width := 1;
    RichEdit1.Visible := False;
    RichEdit2.Visible := true;
    RichEdit2.SetFocus;
  end
  else
  begin
    // self.Width := 300;
    RichEdit2.Visible := False;
    RichEdit1.Visible := true;
    RichEdit1.SetFocus;
  end;

end;

procedure TForm1.RichEdit2KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if FLock then Exit;
  if (Key = 33) or (Key = 34)or(shift = [ssCtrl]) then
  else if Key = 27 then // ESC键
    Application.Minimize
  else
  begin
    ChangeEdit;
    Key := 0;
  end;
end;

procedure TForm1.RichEdit1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin

  if FLock then Exit;
  if (Key = 33) or (Key = 34)or(shift=[ssCtrl]) then //PageUp/PageDown键
  else if Key = 27 then // ESC键
    Application.Minimize
  else
  begin
    ChangeEdit;
    Key := 0;
  end;

end;

procedure TForm1.N3Click(Sender: TObject);
begin
  RichEdit1.PasteFromClipboard;
  SetLine(RichEdit1, 1)
end;

procedure TForm1.N4Click(Sender: TObject);
begin
  RichEdit1.Lines.Clear;
  RePlaceBmk;
end;

procedure TForm1.N5Click(Sender: TObject);
begin
  FLock := true;
end;

procedure TForm1.N6Click(Sender: TObject);
begin
  FLock := False;
end;

procedure TForm1.N7Click(Sender: TObject); //添加
//var FrmBM: TFBookMark;
begin
  {  FrmBM := TFBookMark.Create(nil);
    FrmBM.LineNum := RichEdit1.CaretPos.Y;
    FrmBM.IsFindMark := False;
    FrmBM.ShowModal;
    FreeAndNil(FrmBM);}
end;
{
procedure TForm1.N8Click(Sender: TObject); //查找
var FrmBM: TFBookMark;
begin
  FrmBM := TFBookMark.Create(nil);
  FrmBM.IsFindMark := true;
  FrmBM.ShowModal;
  SetLine(RichEdit1, FrmBM.LineNum - 1);
  FreeAndNil(FrmBM);

end; }