tipmainform.pas

Delphi树和酒店式的框架

  begin
    TblTips.Edit;                { Put dataset into "edit" mode }
    TblTips.Post;               { Generate the BeforePost event }
  end;
end;


procedure TFrmTipExplorer.RtfTipSelectionChange(Sender: TObject);
begin
  with RtfTip.Paragraph do
  begin                                { Update editing buttons }
    try
      FUpdatingTextAttr := True;
      BtnBold.Down := fsBold in RtfTip.SelAttributes.Style;
      BtnItalic.Down := fsItalic in RtfTip.SelAttributes.Style;
      BtnUnderline.Down:= fsUnderline in RtfTip.SelAttributes.Style;
      BtnBullets.Down := Boolean( Numbering );
      EdtFontSize.Text := IntToStr( RtfTip.SelAttributes.Size );
      CbxFontName.Text := RtfTip.SelAttributes.Name;
    finally
      FUpdatingTextAttr := False;
    end;
  end;
end;


function TFrmTipExplorer.TextAttributes: TTextAttributes;
begin
  if RtfTip.SelLength > 0 then
    Result := RtfTip.SelAttributes
  else
    Result := RtfTip.DefAttributes;
end;


procedure TFrmTipExplorer.FormatTextClick(Sender: TObject);
const
  Attributes : array[ 1..3 ] of TFontStyles =
    ( [ fsBold ], [ fsItalic ], [ fsUnderline ] );
begin
  if FUpdatingTextAttr then
    Exit;
  { Sender will be 1) BtnBold, 2) BtnItalic, or 3) BtnUnderline }
  with Sender as TSpeedButton do
    if Down then
      TextAttributes.Style := TextAttributes.Style+Attributes[Tag]
    else
      TextAttributes.Style := TextAttributes.Style-Attributes[Tag];
end;


procedure TFrmTipExplorer.BtnBulletsClick(Sender: TObject);
begin
  if FUpdatingTextAttr then
    Exit;
  RtfTip.Paragraph.Numbering := TNumberingStyle( BtnBullets.Down );
end;


procedure TFrmTipExplorer.CbxFontNameChange(Sender: TObject);
begin
  if FUpdatingTextAttr then
    Exit;
  TextAttributes.Name := CbxFontName.Items[ CbxFontName.ItemIndex ];
end;


procedure TFrmTipExplorer.EdtFontSizeChange(Sender: TObject);
begin
  if FUpdatingTextAttr then
    Exit;
  TextAttributes.Size := StrToInt( EdtFontSize.Text );
end;


procedure TFrmTipExplorer.MnuFontClick(Sender: TObject);
begin
  DlgFont.Font.Assign( TextAttributes );
  if DlgFont.Execute then
    TextAttributes.Assign( DlgFont.Font );
end;


procedure TFrmTipExplorer.ClipboardClick(Sender: TObject);
begin
  { Sender will be 1) BtnCut, 2) BtnCopy, or 3) BtnPaste }
  with Sender as TComponent do
    case Tag of
      1: RtfTip.CutToClipboard;
      2: RtfTip.CopyToClipboard;
      3: RtfTip.PasteFromClipboard;
    end;
end;


procedure TFrmTipExplorer.BtnPrintClick(Sender: TObject);
begin
  RtfTip.Print( TblTips[ 'Subject' ] );    { Printing built in! }
end;


procedure TFrmTipExplorer.RtfTipEnter(Sender: TObject);
begin
  EnableTipFunctions( True );
end;


{== Misc Functions ==}

procedure TFrmTipExplorer.ExpandCollapseClick(Sender: TObject);
begin
  if Sender = MnuExpandAll then
    TvwTips.FullExpand
  else
    TvwTips.FullCollapse;
end;


procedure TFrmTipExplorer.MnuRefreshClick(Sender: TObject);
begin
  UpdateStatusBar( '', '' );
  LoadTips;
end;


procedure TFrmTipExplorer.MnuSelectAllClick(Sender: TObject);
begin
  RtfTip.SelectAll;
end;


procedure TFrmTipExplorer.MnuDeleteClick(Sender: TObject);
var
  Node, CatNode, ParentNode : TTreeNode;
  I : Integer;
begin
  if ActiveControl = RtfTip then
    RtfTip.ClearSelection
  else if ActiveControl = TvwTips then
  begin
    { A category or tip is being deleted }
    Node := TvwTips.Selected;
    ParentNode := Node.Parent;      { Get parent node for later }
    if Node.Level = nlTip then
      TblTips.Delete                 { Delete tip from database }
    else                                    { Delete a category }
    begin
      if Node.HasChildren then
      begin
        if MessageDlg( 'Delete all tips in category?',
                       mtConfirmation, [mbYes, mbNo], 0) = idNo then
          Exit;
        { Delete the Tips from Database }
        TblTips.DisableControls;
        try             { Move table cursor to selected subject }
          for I := 0 to Node.Count - 1 do
          begin
            if TblTips.Locate('Subject', Node.Item[I].Text, []) then
              TblTips.Delete;
          end;
        finally
          TblTips.EnableControls;
        end;
      end;
      TblCategories.Locate( 'Category', Node.Text, [] );
      TblCategories.Delete;                   { Delete category }
    end;
    TvwTips.Items.Delete( Node );            { Delete tree node }
    ParentNode.Selected := True;       { Select the parent node }
  end
  else if ActiveControl = LvwSubjects then
  begin                             { Deleting one or more tips }
    I := 0;
    while I < LvwSubjects.Items.Count do
    begin
      if LvwSubjects.Items[ I ].Selected then
      begin
        if TblTips.Locate( 'Subject',
                           LvwSubjects.Items[ I ].Caption, [] ) then
          TblTips.Delete;            { Delete tip from database }
                                             { Delete tree node }
        TvwTips.Items.Delete( TvwTips.Selected.Item[ I ] );
        LvwSubjects.Items[ I ].Delete;  { Delete from list view }
      end
      else
        Inc( I );
    end;
    UpdateStatusBar( IntToStr( TvwTips.Selected.Count ) +
                     ' Subjects', '' );
  end
  else if ActiveControl = LvwCategories then
  begin
    CatNode := TvwTips.Selected.Item[LvwCategories.Selected.Index];
    if CatNode.HasChildren then
    begin
      if MessageDlg( 'Delete all tips in category?',
                     mtConfirmation, [mbYes, mbNo], 0) = idNo then
        Exit;
      { Delete the Tips from Database }
      TblTips.DisableControls;
      try               { Move table cursor to selected subject }
        for I := 0 to CatNode.Count - 1 do
        begin
          if TblTips.Locate('Subject', CatNode.Item[I].Text,[]) then
            TblTips.Delete;
        end;
      finally
        TblTips.EnableControls;
      end;
    end;
    TblCategories.Locate( 'Category', CatNode.Text, [] );
    TblCategories.Delete;                     { Delete category }

    LvwCategories.Selected.Delete;           { Delete List Item }
    TvwTips.Items.Delete( CatNode );     { Delete category node }
    UpdateStatusBar( IntToStr( TvwTips.Selected.Count ) +
                     ' Categories', '' );
  end;
end; {= TFrmTipExplorer.MnuDeleteClick =}


procedure TFrmTipExplorer.BtnUpOneLevelClick(Sender: TObject);
begin
  if TvwTips.Selected.AbsoluteIndex <> 0 then
    TvwTips.Selected.Parent.Selected := True;
  TvwTips.SetFocus;
end;


procedure TFrmTipExplorer.MnuAboutClick(Sender: TObject);
begin
  FrmAboutBox.ShowModal;
end;


{== Splitter Methods ==}

procedure TFrmTipExplorer.PnlSplitterMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  FDragging := True;
  PnlMask.BoundsRect := PnlSplitter.BoundsRect;
  PnlMask.Left := PnlMask.Left - X;
  PnlMask.Width := PnlMask.Width - 1;

  PnlMask.Visible := True;
  FOrigX := PnlMask.Left;
end;


procedure TFrmTipExplorer.PnlSplitterMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
  if FDragging then
    PnlMask.Left := FOrigX + X;
end;


procedure TFrmTipExplorer.PnlSplitterMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  FDragging := False;
  PnlMask.Visible := False;
  PnlSplitter.Left := PnlMask.Left;
  PnlTree.Width := PnlMask.Left;
end;


{== Display Options Dialog ==}

procedure TFrmTipExplorer.MnuOptionsClick(Sender: TObject);
var
  I : Integer;
begin
  FrmOptions := TFrmOptions.Create( Application );
  try
    with FrmOptions do
    begin
      ChkWinPos.Checked := FSaveWinPos;
      ChkWinSize.Checked := FSaveWinSize;
      case FStartAt of
        saRoot:
          OptRoot.Checked := True;
        saLastSel:
          OptLastSel.Checked := True;
        saSpecific:
          OptSpecific.Checked := True;
      end;
      if FStartAt = saSpecific then
      begin
        { Search for StartAtItem node }
        I := 0;
        while ( I < TvwTips.Items.Count ) and
              ( TvwTips.Items[ I ].Text <> FStartAtItem ) do
        begin
          Inc( I );
        end;
        if I < TvwTips.Items.Count then
          TvwTips.Items[ I ].Selected := True;
      end;
      if ShowModal = idOK then
      begin
        FSaveWinPos := ChkWinPos.Checked;
        FSaveWinSize := ChkWinSize.Checked;
        if OptRoot.Checked then
          FStartAt := saRoot
        else if OptLastSel.Checked then
          FStartAt := saLastSel
        else
          FStartAt := saSpecific;
        if FStartAt = saSpecific then
        begin
          FStartAtItem := TvwTips.Selected.Text;
        end;
      end;
    end;
  finally
    FrmOptions.Free;
  end;
end; {= TFrmTipExplorer.MnuOptionsClick =}


{== Tree View Drag-and-Drop Support ==}

procedure TFrmTipExplorer.TvwTipsMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  { If the left mouse button is pressed and the mouse cursor is  }
  { positioned over the text or bitmap of a node in the tree     }
  { which has a level of 2 (i.e. a tip node), then start the     }
  { drag process.                                                }

  if ( Button = mbLeft ) and
     ( htOnItem in TvwTips.GetHitTestInfoAt( X, Y ) ) and
     ( TvwTips.GetNodeAt( X, Y ).Level = nlTip ) then
  begin
    TvwTips.BeginDrag( False );
  end;
end;


procedure TFrmTipExplorer.TvwTipsDragOver( Sender, Source: TObject;
  X, Y: Integer; State: TDragState; var Accept: Boolean);
var
  Node : TTreeNode;
begin
  if Source = TvwTips then
  begin
    Node := TvwTips.GetNodeAt( X, Y );    { Get the target node }
    if Node <> nil then    { Only allow drops on category nodes }
      Accept := Node.Level = nlCategory;
  end;
end;


procedure TFrmTipExplorer.TvwTipsDragDrop( Sender, Source: TObject;
                                           X, Y : Integer );
var
  TempNode : TTreeNode;
  AttachMode : TNodeAttachMode;
begin
  if TvwTips.Selected = nil then
    Exit;

  AttachMode := naAddChild;    { Add tip as a child of category }

  { Note: Adding the temporary node is a work around to a bug   }
  {       that exists in the TreeView component when moving a   }
  {       node to a another node that doesn't have any children }

  TvwTips.Items.BeginUpdate;
  try
    TempNode := TvwTips.Items.AddChild( TvwTips.DropTarget,
                                        'Temp' );
    try
      { Move the node in the tree view }
      TvwTips.Selected.MoveTo( TvwTips.DropTarget, AttachMode );

      { Now need to update the category of tip in the database }
      TblTips.DisableControls;
      try
        TblTips.Edit;
        TblTips[ 'Category' ] := TvwTips.DropTarget.Text;
        TblTips.Post;
      finally
        TblTips.EnableControls;
      end;

    finally
      TempNode.Free;    { Don't forget to release the temp node }
    end;
  finally
    TvwTips.Items.EndUpdate;
  end;
end; {= TFrmTipExplorer.TvwTipsDragDrop =}


end.