readerp.pas

全屏小说阅读器

unit ReaderP;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Menus, Buttons, ExtCtrls, ComCtrls;

type
  TForm1 = class(TForm)
    PopupMenu1: TPopupMenu;
    Font1: TMenuItem;
    N1: TMenuItem;
    Exit1: TMenuItem;
    FontDialog1: TFontDialog;
    ColorDialog1: TColorDialog;
    Open1: TMenuItem;
    OpenDialog1: TOpenDialog;
    Timer1: TTimer;
    Minimize1: TMenuItem;
    N3: TMenuItem;
    ScrollBar1: TMenuItem;
    Rm: TMenuItem;
    Copy1: TMenuItem;
    Memo1: TMemo;
    procedure Memo1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormCreate(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
    procedure Font1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Open1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Minimize1Click(Sender: TObject);
    procedure ScrollBar1Click(Sender: TObject);
    procedure Copy1Click(Sender: TObject);
    procedure memo1KeyPress(Sender: TObject; var Key: Char);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure SaveFileList(filename:string);
    procedure UpdateFileMenu;
    procedure OnOpenFile(sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Memo1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  HideCaret(Memo1.handle);
  if key=32 then
    SendMessage(Memo1.handle, EM_SCROLL, SB_PAGEDOWN, 0);
  if key=38 then
    SendMessage(Memo1.handle, EM_SCROLL, SB_LINEUP, 0);
  if key=40 then
    SendMessage(Memo1.handle, EM_SCROLL, SB_LINEDOWN, 0);
  if key=37 then
  begin
    memo1.selstart := 0;
    memo1.selLength := 1;
  end;
  if key=39 then
  begin
    Memo1.SelStart := Length(Memo1.Text) - 1;
    memo1.selLength := 1;
  end;
  if key=27 then close;
//  memo1.text:=inttostr(key);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
//  memo1.clear;
  if fileexists(extractfilepath(paramstr(0))+'font') then
  with TStringList.Create do
  begin
    loadfromfile(extractfilepath(paramstr(0))+'font');
    memo1.font.name:=strings[0];
    memo1.font.size:=strtoint(strings[1]);
    memo1.font.color:=strtoint(strings[2]);
    if strings[3]='1' then
      memo1.font.Style := memo1.font.style + [fsBold]
    else
      memo1.font.Style := memo1.font.style - [fsBold];
    if strings[4]='1' then
      memo1.font.Style := memo1.font.style + [fsItalic]
    else
      memo1.font.Style := memo1.font.style - [fsItalic];
    if strings[5]='1' then
      memo1.font.Style := memo1.font.style + [fsUnderline]
    else
      memo1.font.Style := memo1.font.style - [fsUnderline];
  end;
  if paramcount > 0 then
    memo1.lines.loadfromfile(paramstr(1));
  UpdateFileMenu;
  hidecaret(memo1.handle);
end;

procedure TForm1.Exit1Click(Sender: TObject);
begin
  close;
end;

procedure TForm1.Font1Click(Sender: TObject);
begin
  fontdialog1.font := memo1.font;
  if fontdialog1.execute then
    memo1.font := fontdialog1.font;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  with TStringList.Create do
  begin
    add(memo1.font.name);
    add(inttostr(memo1.font.size));
    add(inttostr(memo1.font.color));
    if fsBold in memo1.font.style then  add('1') else add('0');
    if fsItalic in memo1.font.style then  add('1') else add('0');
    if fsUnderline in memo1.font.style then  add('1') else add('0');
    savetofile(extractfilepath(paramstr(0))+'font');
  end;
end;

procedure TForm1.Open1Click(Sender: TObject);
begin
  if opendialog1.execute then
  begin
    memo1.lines.loadfromfile(opendialog1.filename);
    savefilelist(opendialog1.filename);
  end;
  HideCaret(memo1.handle);
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  HideCaret(memo1.handle);
//  Timer1.enabled := false;
end;

procedure TForm1.Minimize1Click(Sender: TObject);
begin
  Application.Minimize;
end;

procedure TForm1.ScrollBar1Click(Sender: TObject);
begin
  if memo1.scrollbars=ssNone then
    memo1.scrollbars := ssBoth
  else
    memo1.ScrollBars := ssNone;
end;

procedure TForm1.OnOpenFile(sender: TObject);
var menu:TMenuItem;
begin
  menu := (sender as TMenuItem);
  caption := menu.caption;
  memo1.lines.loadfromfile(menu.hint);
end;

procedure TForm1.SaveFileList(filename:string);
var menu:TMenuitem;
begin
  with TStringList.create do
  begin
    if not fileexists(extractfilepath(paramstr(0))+'filelist') then
      savetofile(extractfilepath(paramstr(0))+'filelist');
    loadfromfile(extractfilepath(paramstr(0))+'filelist');
    if indexof(filename)=-1 then
    begin
      insert(0,filename);
      savetofile(extractfilepath(paramstr(0))+'filelist');

      menu:=TMenuItem.Create(nil);
      menu.caption:=filename;
      menu.hint:=filename;
      menu.OnClick := OnOpenFile;
      rm.insert(0,menu);
    end;
  end;
end;

procedure TForm1.UpdateFileMenu;
var
  i:integer;
  Menu:TMenuitem;
begin
  if not fileexists(extractfilepath(paramstr(0))+'filelist') then exit;

  for i:=rm.count - 1 to 0 do rm.Delete(i);
  with TStringList.create do
  begin
    loadfromfile(extractfilepath(paramstr(0))+'filelist');

    for i:=0 to count -1 do
    begin
      menu:=TMenuItem.Create(nil);
      menu.caption:=strings[i];
      menu.hint:=strings[i];
      menu.OnClick := OnOpenFile;
      rm.Add(menu);
    end;
  end;
end;

procedure TForm1.Copy1Click(Sender: TObject);
begin
  memo1.readonly := false;
  memo1.Clear;
  memo1.PasteFromClipboard;
  memo1.readonly := true;
  memo1.selstart := 0;
  memo1.selLength := 1;
  memo1.selLength := 0;
end;

procedure TForm1.memo1KeyPress(Sender: TObject; var Key: Char);
begin
  if uppercase(key) = 'V' then
    copy1click(nil);
end;

end.