tipmainform.pas

Delphi树和酒店式的框架

{$DEFINE USE_REGINIFILE}

unit TipMainForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Grids, DBGrids, ExtCtrls, DBCtrls, DB,
  DBTables, ComCtrls, Menus, Buttons;

type
  TStartAt = ( saRoot, saLastSel, saSpecific );

  TFrmTipExplorer = class(TForm)
    PnlToolbar: TPanel;
    MnuMain: TMainMenu;
    MnuFile: TMenuItem;
    MnuExit: TMenuItem;
    Bevel1: TBevel;
    ImlSmall: TImageList;
    ImlLarge: TImageList;
    TblTips: TTable;
    TblCategories: TTable;
    SrcTips: TDataSource;
    StsMain: TStatusBar;
    PnlSplitter: TPanel;
    BtnBold: TSpeedButton;
    BtnItalic: TSpeedButton;
    BtnUnderline: TSpeedButton;
    BtnBullets: TSpeedButton;
    CbxFontName: TComboBox;
    EdtFontSize: TEdit;
    SpnFontSize: TUpDown;
    BtnPrint: TSpeedButton;
    BtnCut: TSpeedButton;
    BtnCopy: TSpeedButton;
    BtnPaste: TSpeedButton;
    PnlMask: TPanel;
    PnlDetail: TPanel;
    NbkListView: TNotebook;
    PnlTree: TPanel;
    TvwTips: TTreeView;
    LvwCategories: TListView;
    MnuNew: TMenuItem;
    MnuSep1: TMenuItem;
    MnuDelete: TMenuItem;
    MnuEdit: TMenuItem;
    MnuCut: TMenuItem;
    MnuCopy: TMenuItem;
    MnuPaste: TMenuItem;
    MnuSep2: TMenuItem;
    MnuFormat: TMenuItem;
    MnuFont: TMenuItem;
    MnuBullets: TMenuItem;
    MnuHelp: TMenuItem;
    MnuAbout: TMenuItem;
    MnuView: TMenuItem;
    MnuViewLarge: TMenuItem;
    MnuViewSmall: TMenuItem;
    MnuViewList: TMenuItem;
    MnuViewDetails: TMenuItem;
    MnuPrint: TMenuItem;
    MnuSep3: TMenuItem;
    MnuNewCategory: TMenuItem;
    MnuNewD1Tip: TMenuItem;
    MnuNewD2Tip: TMenuItem;
    MnuNewTip: TMenuItem;
    MnuSep4: TMenuItem;
    DlgFont: TFontDialog;
    RtfTip: TRichEdit;
    MnuSep5: TMenuItem;
    MnuExpandAll: TMenuItem;
    MnuCollapseAll: TMenuItem;
    MnuSep6: TMenuItem;
    MnuSelectAll: TMenuItem;
    BtnUpOneLevel: TSpeedButton;
    MnuSep7: TMenuItem;
    MnuRefresh: TMenuItem;
    LvwSubjects: TListView;
    MnuTools: TMenuItem;
    MnuOptions: TMenuItem;
    dbMain: TDatabase;
    procedure FormatTextClick(Sender: TObject);
    procedure SrcTipsDataChange(Sender: TObject; Field: TField);
    procedure MnuExitClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure TvwTipsChange(Sender: TObject; Node: TTreeNode);
    procedure TblTipsBeforePost(DataSet: TDataSet);
    procedure RtfTipSelectionChange(Sender: TObject);
    procedure BtnBulletsClick(Sender: TObject);
    procedure CbxFontNameChange(Sender: TObject);
    procedure EdtFontSizeChange(Sender: TObject);
    procedure ClipboardClick(Sender: TObject);
    procedure TvwTipsEdited(Sender: TObject; Node: TTreeNode;
      var S: string);
    procedure TvwTipsEditing(Sender: TObject; Node: TTreeNode;
      var AllowEdit: Boolean);
    procedure LvwSubjectsEdited(Sender: TObject; Item: TListItem;
      var S: string);
    procedure PnlSplitterMouseDown(Sender: TObject;
      Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure PnlSplitterMouseMove(Sender: TObject;
      Shift: TShiftState; X, Y: Integer);
    procedure PnlSplitterMouseUp(Sender: TObject;
      Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure BtnPrintClick(Sender: TObject);
    procedure MnuAboutClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure MnuViewStyleClick(Sender: TObject);
    procedure MnuNewCategoryClick(Sender: TObject);
    procedure MnuNewTipClick(Sender: TObject);
    procedure MnuFontClick(Sender: TObject);
    procedure RtfTipEnter(Sender: TObject);
    procedure LvwSubjectsChange(Sender: TObject; Item: TListItem;
      Change: TItemChange);
    procedure ListViewDblClick(Sender: TObject);
    procedure TvwTipsEnter(Sender: TObject);
    procedure ExpandCollapseClick(Sender: TObject);
    procedure MnuSelectAllClick(Sender: TObject);
    procedure MnuDeleteClick(Sender: TObject);
    procedure BtnUpOneLevelClick(Sender: TObject);
    procedure LvwCategoriesEditing( Sender: TObject;
      Item: TListItem; var AllowEdit: Boolean);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure MnuRefreshClick(Sender: TObject);
    procedure MnuOptionsClick(Sender: TObject);
    procedure TvwTipsMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure TvwTipsDragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure TvwTipsDragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure LvwSubjectsEnter(Sender: TObject);
    procedure LvwCategoriesEnter(Sender: TObject);
  private
    FLoadingTips : Boolean;
    FUpdatingTextAttr : Boolean;
    FDragging : Boolean;
    FOrigX : Integer;
    FSaveWinPos : Boolean;
    FSaveWinSize : Boolean;
    FStartAt : TStartAt;
    FStartAtItem : string;
    function TextAttributes: TTextAttributes;
    procedure EnableTreeViewFunctions( Level : Integer );
    procedure EnableTipFunctions( Enable : Boolean );
    procedure UpdateStatusBar( Panel1, Panel2 : string );
    procedure LoadTips;
    procedure UpdateTip;
    procedure LoadSettings;
    procedure SaveSettings;
    procedure DisplayHint( Sender : TObject );
  public
  end;

var
  FrmTipExplorer: TFrmTipExplorer;

implementation

uses
  RichEdit, ClipBrd, Registry, AboutBoxForm, OptionsForm;

{$R *.DFM}
{$R TipImages.res}       { Include images for tree & list views }

const
  pgCategory = 0;                           { Page index values }
  pgSubject = 1;
  pgTip = 2;

  nlRoot = 0;                               { Node level values }
  nlCategory = 1;
  nlTip = 2;

  TipExplorerKey = 'Software\Visual Developer\Delphi By Design\Tip Explorer';


procedure TFrmTipExplorer.FormCreate(Sender: TObject);
begin
  NbkListView.PageIndex := pgCategory;
  dbMain.Params.Values['PATH']:=ExtractFilePath(Application.EXEName);
  { Load bitmaps for Image Lists from Resource File }
  ImlSmall.ResourceLoad( rtBitmap, 'SmallImages', clTeal );
  ImlLarge.ResourceLoad( rtBitmap, 'LargeImages', clTeal );
  TblTips.Open;
  TblCategories.Open;
  FLoadingTips := True;
  LoadTips;                           { Load tips from database }
  SrcTips.Enabled := True;
  FLoadingTips := False;
  CbxFontName.Items := Screen.Fonts;  { Populate font combo box }
  Application.OnHint := DisplayHint;
  LoadSettings;
  EnableTreeViewFunctions( TvwTips.Selected.Level );
  EnableTipFunctions( TvwTips.Selected.Level = nlTip );
end;


procedure TFrmTipExplorer.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  UpdateTip;            { Make sure a modified tip gets updated }
  SaveSettings;
end;


{$IFDEF USE_REGINIFILE}

procedure TFrmTipExplorer.LoadSettings;
var
  R : TRegIniFile;
  I : Integer;
begin
  R := TRegIniFile.Create( TipExplorerKey );
  try
    { Read AutoSave settings }
    FSaveWinPos := R.ReadBool( 'AutoSave', 'Position', True );
    FSaveWinSize := R.ReadBool( 'AutoSave', 'Size', True );
    FStartAt := TStartAt( R.ReadInteger( 'AutoSave', 'StartAt',
                          Integer( saRoot ) ) );

    { Read StartUp settings }
    FStartAtItem := R.ReadString( 'StartUp', 'StartAtItem', '' );
    Left := R.ReadInteger( 'StartUp', 'Left', 50 );
    Top := R.ReadInteger( 'StartUp', 'Top', 50 );
    Width := R.ReadInteger( 'StartUp', 'Width', 515 );
    Height := R.ReadInteger( 'StartUp', 'Height', 320 );
  finally
    R.Free;
  end;

  { 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; {= TFrmTipExplorer.SaveSettings =}


procedure TFrmTipExplorer.SaveSettings;
var
  R : TRegIniFile;
begin
  R := TRegIniFile.Create( TipExplorerKey );
  try
    { Save AutoSave Settings }
    R.WriteBool( 'AutoSave', 'Position', FSaveWinPos );
    R.WriteBool( 'AutoSave', 'Size', FSaveWinSize );
    R.WriteInteger( 'AutoSave', 'StartAt', Integer( FStartAt ) );

    { Save StartUp settings to Registry }
    case FStartAt of
      saRoot:
        R.WriteString( 'StartUp', 'StartAtItem', '' );
      saLastSel:
        R.WriteString( 'StartUp', 'StartAtItem',
                       TvwTips.Selected.Text );
      saSpecific:
        R.WriteString( 'StartUp', 'StartAtItem', FStartAtItem );
    end;

    if FSaveWinPos then
    begin
      R.WriteInteger( 'StartUp', 'Left', Left );
      R.WriteInteger( 'StartUp', 'Top', Top );
    end;

    if FSaveWinSize then
    begin
      R.WriteInteger( 'StartUp', 'Width', Width );
      R.WriteInteger( 'StartUp', 'Height', Height );
    end;

  finally
    R.Free;
  end;
end; {= TFrmTipExplorer.SaveSettings =}

{$ELSE}

procedure TFrmTipExplorer.LoadSettings;
var
  R : TRegistry;
  I : Integer;
begin
  R := TRegistry.Create;
  try
    R.OpenKey( TipExplorerKey + '\AutoSave', True );
    try
      if R.ValueExists( 'Position' ) then
        FSaveWinPos := R.ReadBool( 'Position' )
      else
        FSaveWinPos := True;

      if R.ValueExists( 'Size' ) then
        FSaveWinSize := R.ReadBool( 'Size' )
      else
        FSaveWinSize := True;

      if R.ValueExists( 'StartAt' ) then
        FStartAt := TStartAt( R.ReadInteger( 'StartAt' ) )
      else
        FStartAt := saRoot;
    finally
      R.CloseKey;
    end;

    R.OpenKey( TipExplorerKey + '\StartUp', True );
    try
      { Get Startup Settings }
      if R.ValueExists( 'StartAtItem' ) then
        FStartAtItem := R.ReadString( 'StartAtItem' )
      else
        FStartAtItem := '';

      if R.ValueExists( 'Left' ) then
        Left := R.ReadInteger( 'Left' )
      else
        Left := 50;

      if R.ValueExists( 'Top' ) then
        Top := R.ReadInteger( 'Top' )
      else
        Top := 50;

      if R.ValueExists( 'Width' ) then
        Width := R.ReadInteger( 'Width' )
      else
        Width := 515;

      if R.ValueExists( 'Height' ) then
        Height := R.ReadInteger( 'Height' )
      else
        Height := 320;

    finally
      R.CloseKey;
    end;

  finally
    R.Free;
  end;

  { 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; {= TFrmTipExplorer.LoadSettings =}


procedure TFrmTipExplorer.SaveSettings;
var
  R : TRegistry;
begin
  R := TRegistry.Create;
  try
    R.OpenKey( TipExplorerKey + '\AutoSave', True );
    try
      { Save AutoSave Settings to Registry }
      R.WriteBool( 'Position', FSaveWinPos );
      R.WriteBool( 'Size', FSaveWinSize );
      R.WriteInteger( 'StartAt', Integer( FStartAt ) );
    finally
      R.CloseKey;
    end;

    R.OpenKey( TipExplorerKey + '\StartUp', True );
    try
      { Save StartUp settings to Registry }
      case FStartAt of
        saRoot:
          R.WriteString( 'StartAtItem', '' );
        saLastSel:
          R.WriteString( 'StartAtItem',
                         TvwTips.Selected.Text );
        saSpecific:
          R.WriteString( 'StartAtItem', FStartAtItem );
      end;

      if FSaveWinPos then
      begin
        R.WriteInteger( 'Left', Left );
        R.WriteInteger( 'Top', Top );
      end;

      if FSaveWinSize then
      begin
        R.WriteInteger( 'Width', Width );
        R.WriteInteger( 'Height', Height );