unit1.pas

秘密阅读工具

function CurPath: string;
begin
  Result := ExtractFilePath(application.exename);
end;

//==============================================================================
// 保存文件、读取文件
//==============================================================================

procedure TForm1.RePlaceBmk; //重置书签菜单为未选中
begin
  u1.Checked := False;
  N12.Checked := False;
  N17.Checked := False;
  N18.Checked := False;
  N19.Checked := False;
end;

function TForm1.BookStr: string;
begin
  if u1.Checked then
    Result := inttostr(u1.tag);
  if N12.Checked then
    Result := Result + inttostr(N12.tag);
  if N17.Checked then
    Result := Result + inttostr(N17.tag);
  if N18.Checked then
    Result := Result + inttostr(N18.tag);
  if N19.Checked then
    Result := Result + inttostr(N19.tag);
end;

procedure TForm1.SaveFile(FileName: string);
begin
  mmo1.Lines.text := RichEdit1.Lines.text;
  mmo1.Lines.Add(BmkFlag);
  mmo1.Lines.Add(BookStr);
  mmo1.Lines.SaveToFile(FileName);
end;
//-----------------------------
procedure TForm1.LoadFile(FileName: string);
var
  nCnt, i, n: Integer;
  sNum: string;
begin
  RePlaceBmk;
  if FileExists(FileName) then
  begin
    mmo1.Lines.LoadFromFile(FileName);
    nCnt := mmo1.Lines.Count - 1;
    if mmo1.Lines[nCnt - 1] = BmkFlag then
    begin
      sNum := trim(mmo1.Lines[nCnt]);
      for i := 1 to Length(sNum) do
      begin
        if IsNumber(sNum[i]) then
        begin
          n := StrToInt(sNum[i]);
          if u1.tag = n then
            u1.Checked := true
          else if N12.tag = n then
            N12.Checked := true
          else if N17.tag = n then
            N17.Checked := true
          else if N18.tag = n then
            N18.Checked := true
          else if N19.tag = n then
            N19.Checked := true;
        end;
      end;
      mmo1.Lines[nCnt - 1] := '';
      mmo1.Lines[nCnt] := '';
    end;

  end;
  RichEdit1.Lines.text := mmo1.Lines.text;
  SetLine(RichEdit1, 1);

end;

procedure TForm1.N9Click(Sender: TObject); //保存文件
var FileName: string;
begin
  FileName := CurPath + 'CurBook.Bk';
  SaveFile(FileName);

end;

procedure TForm1.N10Click(Sender: TObject); //读取文件
var FileName: string;

begin
  FileName := CurPath + 'CurBook.Bk';
  LoadFile(FileName);
end;

procedure TForm1.N8Click(Sender: TObject); //save file
begin
  if dlgSave1.Execute then
    SaveFile(dlgSave1.FileName);
end;

procedure TForm1.N20Click(Sender: TObject); //load file
begin
  if dlgOpen1.Execute then
    LoadFile(dlgOpen1.FileName);

end;
//==============================================================================

procedure TForm1.N11Click(Sender: TObject);
begin
  if (FStyle mod 2) <> 0 then
    self.BorderStyle := bssizeable
  else
    self.BorderStyle := bsnone;
  FStyle := FStyle + 1;
end;

//------------------------------------------------------------------------------
{procedure TForm1.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
//Params.Style := Params.Style xor ws_caption xor ws_popup;
Params.Style := WS_THICKFRAME or WS_POPUP or WS_BORDER;   }

 {    inherited CreateParams(Params);
     with Params do
     begin
          Style :=Style and (not WS_CAPTION);
          Style :=Style or WS_POPUP
     end
end;    }
procedure TForm1.Panel2MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  dx := X;
  dy := Y;
  if Button <> mbRight then
  begin
    ReleaseCapture;
    Form1.Perform(WM_SysCommand, $F017, 0);
  end
  else
    self.BorderWidth := 1;
end;

procedure TForm1.Panel2MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  mx, my: Integer;
begin
  if Shift = [ssRight] then
  begin
    mx := X - dx;
    my := Y - dy;

    if (self.Width < 50) or (self.Height < 20) then
    begin
      if mx <0 then Exit;
      if my <0 then exit;

    end;

    //SetWindowPos(self.Handle,HWND_TOP,form1.Left,form1.Left,form1.Width+mx,form1.Height+my,SWP_DRAWFRAME);

   // if (mx <> 0) then
     // Form1.Width := Form1.Width + mx; x轴闪烁厉害，不好用
    if (my <> 0) then
      Form1.Height := Form1.Height + my;

    dx:=x;
    dy:=y;
  end;
end;

procedure TForm1.Panel2MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  self.BorderWidth := 0;
end;

procedure TForm1.N14Click(Sender: TObject);
begin
  FGetClipTxt := not FGetClipTxt;
  N14.Checked := not N14.Checked;
end;

procedure TForm1.N15Click(Sender: TObject);
begin
  N15.Checked := not N15.Checked;
  if N15.Checked then
    self.FormStyle := fsStayOnTop
  else
    self.FormStyle := fsNormal;
end;

procedure TForm1.N16Click(Sender: TObject);
begin
  ShowInforMsg('总行数：' + inttostr(RichEdit1.Lines.Count) + #10 + #10
    + '当前行：' + inttostr(RichEdit1.CaretPos.Y + 1));
end;

procedure TForm1.RichEdit2MouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
begin
  if WheelDelta < 0 then
    RichEdit2.Perform(WM_VSCROLL, SB_LINEDOWN, 0)
  else
    RichEdit2.Perform(WM_VSCROLL, SB_LINEUP, 0);

end;

procedure TForm1.RichEdit1MouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
begin
  if WheelDelta < 0 then
    RichEdit1.Perform(WM_VSCROLL, SB_LINEDOWN, 0)
  else
    RichEdit1.Perform(WM_VSCROLL, SB_LINEUP, 0);
end;

procedure TForm1.SetBookMark(Sender: TObject);
var
  s: string;

  FoundAt: LongInt;
  StartPos, ToEnd: Integer;
begin

  (Sender as TMenuItem).Checked := not (Sender as TMenuItem).Checked;
  s := sBook[(Sender as TMenuItem).tag];
  if (Sender as TMenuItem).Checked then
  begin

    with RichEdit1 do
    begin
      SelText := s;
      SelStart := SelStart - 2;
      SelLength := 2;
      SelAttributes.Size := 1;
    end
  end
  else
  begin
    with RichEdit1 do
    begin
      if SelLength <> 0 then
        StartPos := SelStart + SelLength
      else
        StartPos := 0;
      ToEnd := Length(text) - StartPos;

      FoundAt := FindText(s, StartPos, ToEnd, [stMatchCase]);
      if FoundAt <> -1 then
      begin
        SetFocus;
        SelStart := FoundAt;
        SelLength := Length(s);
        SelText := '';
        SetLine(RichEdit1, RichEdit1.CaretPos.Y);
      end;
    end;
  end;

end;

procedure TForm1.u1Click(Sender: TObject);
begin
  SetBookMark(Sender);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  N9Click(nil); //存临时文件
end;

procedure TForm1.q1Click(Sender: TObject);
begin
  application.CreateForm(TColorForm, ColorForm);
  hide;
  delay(0.2);
  ColorForm.Show;
end;



procedure TForm1.N22Click(Sender: TObject);
var sPage:string;
    nPage:integer;
begin
if InputQuery('定位','总行数：'+inttostr(RichEdit1.Lines.Count)+#13
             + '当前行：'+inttostr(RichEdit1.CaretPos.Y + 1)+#13
             + '请输入行数：',sPage) then
   if isNumber(sPage) then
   begin
     nPage:=round(strtofloat(sPage));
     SetLine(RichEdit1,nPage);
   end;

end;


procedure TForm1.Panel2DblClick(Sender: TObject);
begin

  if not FViewCap then
  begin
    FViewCap:=true;
    if self.BorderStyle<>bsnone then
      self.BorderStyle := bsnone;
    Timer1.Enabled:=true;
    exit;
  end;

  if FViewCap then
  begin
    self.BorderStyle := bssizeable ;
    FViewCap:=false;
  end
  else
  begin

    //
  end;
//
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  timer1.Enabled:=false;
  FViewCap:=false;

  //
end;

end.

{
 开发笔记：

1、书签标志：ǔǖǘǚǜ
备用：àáèéêùúüǒ→↗≒§①②③④⑤⑥⑦⑧⑨⑩


2、 var 
      I : integer ;
  begin 

    I:= Trunc(123.56); 123  截尾
    i:= Round(123.56); 124  四舍五入
  end; 

}