unit_main.pas

电子阅读器,适合处学者使用和学习.有意见联系我 .

  If MainText.SelLength>0 Then
  Begin
    Case MainText.TOM.Selection.Font.Bold Of
      0:
        Begin
          BitB:=False;
          TB.Down:=BitB
        End;
      -1:
        Begin
          BitB:=True;
          TB.Down:=BitB
        End;
    End;
    Case MainText.TOM.Selection.Font.Italic Of
      0:
        Begin
          BitI:=False;
          TI.Down:=BitI
        End;
      -1:
        Begin
          BitI:=True;
          TI.Down:=BitI
        End;
    End;
    Case MainText.TOM.Selection.Font.Underline Of
      0:
        Begin
          BitU:=False;
          TU.Down:=BitU
        End;
      1:
        Begin
          BitU:=True;
          TU.Down:=BitU
        End;
    End;

    Com_Front.Text:=MainText.SelAttributes.Name;
    Com_Size.Text:=IntToStr(MainText.SelAttributes.Size);
  End;

End;

Procedure TF_Main.B_BcolorsClick(Sender: TObject);
Begin
  BFontC:=False;
  PopupColors.Popup(B_Bcolors, taLeftJustify);
End;

Procedure TF_Main.TBClick(Sender: TObject);
Begin
  BitB:=Not(BitB);
  TB.Down:=BitB;
  Case TB.Down Of
    False: MainText.TOM.Selection.Font.Bold:=0;
    True: MainText.TOM.Selection.Font.Bold:=-1;
  End;

End;

Procedure TF_Main.TIClick(Sender: TObject);
Begin
  BitI:=Not(BitI);
  TI.Down:=BitI;
  Case TI.Down Of
    False: MainText.TOM.Selection.Font.Italic:=0;
    True: MainText.TOM.Selection.Font.Italic:=-1;
  End;
End;

Procedure TF_Main.TUClick(Sender: TObject);
Begin
  BitU:=Not(BitU);
  TU.Down:=BitU;
  Case TU.Down Of
    False: MainText.TOM.Selection.Font.Underline:=0;
    True: MainText.TOM.Selection.Font.Underline:=1;
  End;
End;

Procedure TF_Main.BitBtn1Click(Sender: TObject);
Begin
  If TreeView.Selected<>Nil Then
    NodeMoveUp(TreeView.Selected);
End;

Procedure TF_Main.BitBtn2Click(Sender: TObject);
Begin
  If TreeView.Selected<>Nil Then
    NodeMoveDown(TreeView.Selected);
End;
Procedure TF_Main.TreeViewMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
Begin
  If (Not(Shift>= [ssShift]))And(Not(Shift>= [ssCtrl])) Then Exit;

  With Sender As TTreeView Do
  Begin
    If (Button=mbLeft)And(htOnItem In GetHitTestInfoAt(X, Y)) Then
      BeginDrag(False);
  End;
End;

Procedure TF_Main.TreeViewDragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; Var Accept: Boolean);
Var
  aNode: TTreeNode;
  ks: TkeyBoardState;
Begin
  Accept:=(Source Is TTreeView);
  With Sender As TTreeView Do
  Begin
    aNode:=GetNodeAt(X, Y);
    If aNode<>Nil Then
    Begin
      //Accept := true; // 允许拖动
      FMoveAsChild:=False;
      GetKeyboardState(ks);
      If ks[VK_CONTROL]And $80<>0 Then
        FMoveAsChild:=True;
      //      Items.BeginUpdate;
            // 控制向上滚动
      If Y<=15 Then
        SendMessage(Handle, WM_VScroll, sb_Lineup, 0)
      Else{// 控制向下滚动}  If (Height-Y<=25) Then
        SendMessage(Handle, WM_VScroll, sb_Linedown, 0);
      //Refresh;
//      Items.EndUpdate;
    End;
  End;
End;
Procedure myMoveNodes(tv: TTreeView; dNode, NeedMoveNodes: TTreeNode; MoveAsChild: Boolean);
Var
  aNode: TTreeNode;
  i: Integer;
Begin
  If MoveAsChild Then
    aNode:=tv.Items.AddChild(dNode, NeedMoveNodes.Text)
  Else
    aNode:=tv.Items.Insert(dNode, NeedMoveNodes.Text);

  For i:=0 To NeedMoveNodes.Count-1 Do
  Begin
    myMoveNodes(tv, aNode, NeedMoveNodes.Item[i], True);
  End;
End;

Procedure TF_Main.TreeViewDragDrop(Sender, Source: TObject; X, Y: Integer);
Var
  sNode, dNode, aNode: TTreeNode;
Begin
  sNode:=(Source As TTreeView).Selected;
  If sNode=Nil Then Exit;

  dNode:=(Sender As TTreeView).GetNodeAt(X, Y);
  If dNode=Nil Then Exit;

  (Sender As TTreeView).Items.BeginUpdate;
  If FMoveAsChild Then // 作为孩子， 这段代码不够优化，为的是更好地移动对应节点内容
  Begin
    aNode:=dNode.GetNextSibling;
    If aNode=Nil Then
    Begin
      If Sender=Source Then
      Begin
        aNode:=(Sender As TTreeView).Items.AddChild(dNode, 'Temp');
        sNode.MoveTo(aNode, naInsert);
        aNode.Delete;
      End
      Else
      Begin
        myMoveNodes(Sender As TTreeView, dNode, sNode, True);
        (Sender As TTreeView).Selected:=dNode;
      End;
    End
    Else
    Begin
      If Sender=Source Then
        (Sender As TTreeView).Selected.MoveTo(dNode, naAddChild)
      Else
      Begin
        myMoveNodes(Sender As TTreeView, dNode, sNode, True);
        (Sender As TTreeView).Selected:=dNode;
      End;
    End;
  End
  Else
  Begin// 移到前面
    If Sender=Source Then
      (Sender As TTreeView).Selected.MoveTo(dNode, naInsert)
    Else
    Begin
      myMoveNodes(Sender As TTreeView, dNode, sNode, False);
      (Sender As TTreeView).Selected:=dNode;
    End;
  End;
  (Sender As TTreeView).Items.EndUpdate;

  FMoveAsChild:=False;
End;

Procedure TF_Main.actUnderlineTealExecute(Sender: TObject);
Var
  actAction: TAction;
Begin
  actAction:=TAction(Sender);
  MainText.TOM.Selection.Font.Underline:=actAction.Tag;
  actAction.Checked:=True;
  If actAction.Tag=0 Then
    TB.Down:=False
  Else
    TB.Down:=True;
End;

Procedure TF_Main.N19Click(Sender: TObject);
Begin
  N26.Checked:=MainText.WordWrap;
End;

Procedure TF_Main.N26Click(Sender: TObject);
Begin
  N26.Checked:=Not(N26.Checked);
  If N26.Checked=False Then
  Begin
    MainText.WordWrap:=False;
    MainText.ScrollBars:=ssBoth;
  End
  Else
  Begin
    MainText.WordWrap:=True;
    MainText.ScrollBars:=ssVertical;
  End;
End;

Procedure TF_Main.N10Click(Sender: TObject); //另存为
Var
  iTargetFile: Integer;
  ToFileName, SMsgBox: String;
  BkInfor: InFor;
Label
  LAsk;
  Procedure SaveEBook;
  Begin
    SFileName:=ToFileName;

    If TreeView.Selected<>Nil Then
      MainText.Lines.SaveToFile(Smulu+'Temp\File\'+TreeView.Selected.Text+'.bop'); //保存文本

    VCLZip1.IncludeHiddenFiles:=True;
    VCLZip1.IncludeSysFiles:=False;
    VCLZip1.IncludeReadOnlyFiles:=True;
    VCLZip1.IncludeArchiveFiles:=True;

    VCLZip1.StorePaths:=False;

    VCLZip1.RootDir:=Smulu+'Temp\File';
    VCLZip1.ZipName:=ToFileName;
    VCLZip1.FilesList.Add('*.*');

    VCLZip1.Recurse:=True;

    BkInfor.SWriter:='';
    BkInfor.SMaker:='';
    BkInfor.SInfor:='';
    BkInfor.SRemark:='';
    BkInfor.SLabel:='';
    BkInfor.SPass:='';
    BkInfor.BReadOnly:=False;
    BkInfor.SFlag:=CFlag;

    If VCLZip1.Zip>0 Then
    Begin
      If FileExists(ToFileName)=False Then
      Begin
        MessageBox(Handle, pchar(Error_Compress), pchar('信息'),
          MB_ICONINFORMATION Or MB_OK);
        Addlog('Error_Compress');
        Exit;
      End;

      iTargetFile:=FileOpen(ToFileName, fmOpenReadWrite);
      Try
        Try
          FileSeek(iTargetFile, 0, soFromEnd);
          FileWrite(iTargetFile, BkInfor, SizeOf(BkInfor));
        Except
          MessageBox(Handle, pchar(Error_Stream), pchar('信息'),
            MB_ICONINFORMATION Or MB_OK);
          Addlog('Error_Stream');
        End
      Finally
        FileClose(iTargetFile)
      End;
      MessageBox(Handle, pchar('保存成功!'), pchar('成功'),
        MB_ICONINFORMATION Or MB_OK);
      BChange:=False;
      STitle:=getbookname(SFileName);
      TreeView.Selected:=TreeView.Items.Item[0];
      F_Main.Caption:='电子阅览者 [Elcreader]－'+STitle+' : '+TreeView.Selected.Text;
    End
    Else
    Begin
      MessageBox(Handle, pchar('保存失败!'), pchar('失败'),
        MB_ICONINFORMATION Or MB_OK);
      Addlog('Cannot make E-Book');
    End;
  End;
Begin
  LAsk:
  If TreeView.Items.Count=0 Then
  Begin
    MessageBox(Handle, pchar('图书文件为空!'), pchar('信息'),
      MB_ICONINFORMATION Or MB_OK);
    Exit;
  End;

  SaveDialog.FileName:=TreeView.Items.Item[0].Text;

  ToFileName:='';

  If SaveDialog.Execute Then //保存文件对话框
    ToFileName:=SaveDialog.FileName;

  If ToFileName='' Then Exit;

  If FileExists(ToFileName) Then
  Begin
    SMsgBox:=ToFileName+' 已存在。'+#13+'要替换它吗?';
    If MessageBox(Handle, pchar(SMsgBox), pchar('另存为'),
      MB_ICONWARNING Or MB_YESNO)=IDyes Then
    Begin
      SaveEBook;
    End
    Else
    Begin
      Goto LAsk;
    End;
  End
  Else
  Begin
    SaveEBook
  End;

End;

Procedure TF_Main.N12Click(Sender: TObject);
Begin
  Close;
End;

Procedure TF_Main.N13Click(Sender: TObject);
Begin
  F_Made.Show;
End;

Procedure TF_Main.FormCloseQuery(Sender: TObject; Var CanClose: Boolean);
Begin
  CanClose:=True;
  If (BChange=True)And(TreeView.Items.Count>0) Then
    If MessageBox(Handle, pchar('图书文件已经改变,是否保存?'), pchar('电子阅览者'),
      MB_ICONQUESTION Or MB_YESNO)=IDyes Then
      N5.Click;
End;

Procedure TF_Main.TreeViewDeletion(Sender: TObject; Node: TTreeNode);
Begin
  BChange:=True;
End;

Procedure TF_Main.TreeViewAddition(Sender: TObject; Node: TTreeNode);
Begin
  BChange:=True;
End;

Procedure TF_Main.N20Click(Sender: TObject);
Begin
  ShellExecute(Handle, 'open', 'http://www.lanwet.com/soft/bbs', Nil, Nil, SW_SHOWNORMAL);
End;

Procedure TF_Main.N21Click(Sender: TObject);
Begin
  ShellExecute(Handle, 'open', 'mailto:[e-mail]', Nil, Nil, SW_SHOWNORMAL);
End;

Procedure TF_Main.N22Click(Sender: TObject);
Begin
  ShellExecute(Handle, 'open', 'http://soft.lanwet.com', Nil, Nil, SW_SHOWNORMAL);
End;

End.