{**************************************************************************
 * This module created by Dmitry Yatchenko dimon@kremen.ukrtel.net        *
 *	Ported to IBO by Andrew Semack 	   sammy@centr-office.poltava.ua  *
 **************************************************************************}

unit
  IB_TreeView;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, IB_Components, Menus, CommCtrl;
  
type
  tSaveSelection = procedure( id: integer ) of object;
  tClearData     = procedure of object;
  tSaveData      = procedure( id,
                              master: integer ) of object;
  tNewData       = function(     Amaster: integer;
                                 Aauto: boolean;
                             var Aid: integer ): boolean of object;
  tChangeData    = function(     Amaster,
                                 Aid: integer;
                             var Aname: string ): boolean of object;
  tCopyData      = function(     AsourceID,
                                 AdestinID: integer;
                             var Aname: string ): boolean of object;
                             
  tReadWrite     = ( modeRead, modeWrite );
  
  TIB_TreeView = class( TCustomTreeView )
  private
    FDataset    : tib_Dataset;
    FKeyField   : string;
    FMasterField: string;
    FDataField  : string;
    FSelectionField: string;
    FSaveSelection: tSaveSelection;
    FClearSelection: tClearData;
    FSaveData: tSaveData;
    FDeleteData: tSaveSelection;
    FNewData: tNewData;
    FChangeData: tChangeData;
    FCopyData: tCopyData;
    FRootID: longint;
    FTrashID: longint;
    FReadWrite: tReadWrite;
    FCopyEnable: boolean;
    FSelectEnable: boolean;
    procedure WMNotify( var Message: TWMNotify ); message WM_NOTIFY;
    procedure SetDataset( ADataset: TIB_Dataset );

  protected
    PopupMenu1: TPopupMenu;
    Select1: TMenuItem;
    Cut1:    TMenuItem;
    Delete1: TMenuItem;
    Change1: TMenuItem;
    Move1:   TMenuItem;
    Copy1:   TMenuItem;
    Save1:   TMenuItem;
    Insert1: TMenuItem;
    Insert2: TMenuItem;
    ImageList1: tImageList;

    old1: ttreenode;
    old2: ttreenode;
    function FindNext( var nod: tTreeNode ): boolean;
    function FindNextChild( parent: tTreeNode; var nod: tTreeNode ): boolean;
    procedure SelectMe( Sender: TObject );
    procedure DeleteMe( Sender: TObject );
    procedure CutMe( Sender: TObject );
    procedure MoveMe( Sender: TObject );
    procedure RefreshMe( Sender: TObject );
    procedure InsertMe( Sender: TObject );
    procedure InsertUp( Sender: TObject );
    procedure ChangeMe( Sender: TObject );
    procedure CopyMe( Sender: TObject );
    function  GetCurrentID:integer;
    procedure SetReadWrite(value:tReadWrite);
    procedure EnableCopy(value:boolean);
    procedure EnableSelection(value:boolean);

    procedure Notification( AComponent: TComponent;
                            Operation: TOperation); override;

  public
    constructor Create(AOwner: TComponent);override;
    procedure LoadData;
    procedure SaveAll;
    procedure SaveMe( Sender: TObject );
    function  FindNode(id:integer):tTreeNode;
  published
    property Align;
    property Font;
    property OnChange;

    property Dataset: tib_Dataset read fDataset write SetDataset;
    property Field_Key: string read FKeyField write FKeyField;
    property Field_Master: string read FMasterField write FMasterField;
    property Field_Data: string read FDataField write FDataField;
    property Field_Selection: string read FSelectionField write FSelectionField;
    property SaveSelection: tSaveSelection read FSaveSelection
                                           write FSaveSelection;
    property OnClearSelection: tClearData read fClearSelection
                                          write FClearSelection;
    property OnSaveData: tSaveData read FSaveData write FSaveData;
    property OnDeleteData: tSaveSelection read FDeleteData write FDeleteData;
    property OnNewData: tNewData read FNewData write FNewData ;
    property ChangeData: tChangeData read FChangeData write FChangeData;
    property CurrentID: integer read GetCurrentID;
    property RootID: longint  read FRootID
                              write FRootID
                              default 0;
    property CopyData: tCopyData read FCopyData write FCopyData;
    property ReadWrite: tReadWrite read fReadWrite write SetReadWrite;
    property CopyEnable: boolean  read FCopyEnable
                                  write EnableCopy
                                  default false;
    property TrashID: longint read FTrashID write FTrashID;
    property SelectEnable: boolean read FSelectEnable write EnableSelection;
  end;

  tMissed = record
    Name: string;
    key: integer;
    master: integer;
    selection: boolean;
  End;
  pMissed = ^tMissed;

//procedure Register;

implementation

{$R IB_TreeView.res}

procedure TIB_TreeView.WMNotify( var Message: TWMNotify );
begin
// if FToolTips then inherited;
end;

constructor TIB_TreeView.Create( AOwner: TComponent );
var
  Bmp: tBitmap;
begin
  inherited Create(AOwner);
  if not (csDesigning in ComponentState) then
  begin
    PopupMenu1 := TPopupMenu.Create( Self );
    Select1 := TMenuItem.Create( Self );

    Select1.Caption := 'Select';
    Select1.ShortCut := 45;
    Select1.OnClick := SelectMe;
    Select1.Enabled := FSelectEnable;
    Select1.Visible := FSelectEnable;
    PopupMenu1.Items.Add( Select1 );

    Save1 := TMenuItem.Create( Self );
    Save1.Caption := 'Save';
    Save1.ShortCut := 113;
    Save1.OnClick := SaveMe;
    Save1.Enabled := FSelectEnable;
    Save1.Visible := FSelectEnable;
    PopupMenu1.Items.Add( Save1 );

    Change1 := TMenuItem.Create( Self );
    Change1.Caption := 'Change';
    Change1.ShortCut := 115;
    Change1.onclick := ChangeMe;
    Change1.Enabled := ReadWrite = modeWrite;
    PopupMenu1.Items.Add(Change1);

    Move1 := TMenuItem.Create( Self );
    Move1.Caption := 'Move';
    Move1.Enabled := False;
    Move1.Visible := false;
    Move1.ShortCut := 116;
    Move1.onclick := MoveMe;
    PopupMenu1.Items.Add(Move1);

    Copy1 := TMenuItem.Create( Self );
    Copy1.Caption := 'Copy';
    Copy1.Enabled := False;
    Copy1.Visible := false;
    Copy1.ShortCut := 8308;
    Copy1.onclick := CopyMe;
    PopupMenu1.Items.Add(Copy1);

    Cut1 := TMenuItem.Create( Self );
    Cut1.Caption := 'Cut';
    Cut1.ShortCut := 117;
    Cut1.onclick := CutMe;
    Cut1.Enabled := ReadWrite=modeWrite;
    PopupMenu1.Items.Add(Cut1);

    Insert1 :=  TMenuItem.Create( Self );
    Insert1.Caption := 'Insert';
    Insert1.ShortCut := 118;
    Insert1.onclick := InsertUp;
    Insert1.Enabled := ReadWrite=modeWrite;
    PopupMenu1.Items.Add(Insert1);

    Insert2 :=  TMenuItem.Create( Self );
    Insert2.Caption := 'Add';
    Insert2.ShortCut := 8310;
    Insert2.onclick := InsertMe;
    Insert2.Enabled := ReadWrite=modeWrite;
    PopupMenu1.Items.Add(Insert2);

    Delete1 := TMenuItem.Create( Self );
    Delete1.Caption := 'Delete';
    Delete1.ShortCut := 119;
    Delete1.OnClick := DeleteMe;
    Delete1.Enabled := ReadWrite = modeWrite;
    PopupMenu1.Items.Add(Delete1);

    PopupMenu1.AutoPopup := True;
    PopupMenu := PopupMenu1;

    ImageList1 := TImageList.Create( Self );
    Bmp := tBitmap.Create;
    Bmp.LoadFromResourceName(HInstance,'CHECK');
    ImageList1.Add(Bmp,nil);

    Bmp := tBitmap.Create;
    Bmp.LoadFromResourceName(HInstance,'UNCHECK');
    ImageList1.Add(Bmp,nil);

    Bmp := tBitmap.Create;
    Bmp.LoadFromResourceName(HInstance,'CUT');
    ImageList1.Add(Bmp,nil);

    Images := ImageList1;
  end;
  ReadOnly := true;
end;

procedure TIB_TreeView.SetDataset( ADataset: TIB_Dataset );
begin
  FDataset := ADataset;
  if Assigned( FDataset ) then
    FDataset.FreeNotification( Self );
end;

procedure TIB_TreeView.Notification( AComponent: TComponent;
                                     Operation: TOperation);
begin
  inherited Notification( AComponent, Operation );
  if ( AComponent = FDataset ) and ( Operation = opRemove ) then
    FDataset := nil; 
end;

procedure TIB_TreeView.LoadData;
var
  NotFound: tList;
  nod: tTreeNode;
  Missed: pMissed;
  pos: integer;
  old: integer;
  dat: pinteger;
  MstCol: TIB_Column;
  KeyCol: TIB_Column;
  DatCol: TIB_Column;
  SelCol: TIB_Column;
  wasOpen: boolean;
  SkipItem: boolean;
begin
  NotFound := tlist.Create;
  items.Clear;
  Old1 := nil;
  Old2 := nil;
  if not Assigned( FDataset ) or not ( FDataset.Prepared ) then
    exit;

  MstCol := FDataset.FieldByName( FMasterField );
  KeyCol := FDataset.FieldByName( FKeyField );
  DatCol := FDataset.FieldByName( FDataField );
  if FSelectionField <> '' then
    SelCol := FDataset.FieldByName( FSelectionField )
  else
    SelCol := nil;

  wasOpen := FDataset.Active;
  try
    FDataset.Open;
    if FDataset.Unidirectional and ( FDataset.RowNum = FDataset.BofRowNum ) and
       not FDataset.Eof then
      FDataset.Next;
    while not FDataset.Eof do
    begin
      SkipItem := false;
      if ( MstCol.AsInteger = RootID ) or
         ( KeyCol.AsInteger = TrashID ) then
        nod := nil
      else
      begin
        nod := FindNode( MstCol.AsInteger );
        if not Assigned( nod ) then
        begin
           New( Missed );
           Missed.Name  := DatCol.AsString;
           Missed.key   := KeyCol.AsInteger;
           Missed.master := MstCol.AsInteger;
           Missed.selection := Assigned( SelCol ) and SelCol.IsNull;
           NotFound.Add( Missed );
           SkipItem := true;
        end;
      end;
      if not SkipItem then
      begin
        New( dat );
        dat^ := KeyCol.AsInteger;
        nod := Self.Items.AddChildObject( nod, DatCol.AsString, dat );
        if ( FSelectionField <> '' ) and ( SelCol.IsNull ) then
          nod.ImageIndex := 1;
      
        nod.SelectedIndex := nod.ImageIndex;
        old1 := nod;
        old2 := nod.parent;
      end;
      FDataset.Next;
    end;
  finally
    if not wasOpen then
      FDataset.Close;
  end;
  old := -1;
  while ( NotFound.Count  > 0   ) and
        ( NotFound.Count <> old ) do
  begin
    old := NotFound.Count;
    for pos := NotFound.Count downto 1 do
    begin
      missed := NotFound[ pos-1 ];
      nod := FindNode( missed.master );
      if Assigned( nod ) then
      begin
        New( dat );
        dat^ := missed.key;
        nod := Self.Items.AddChildObject( nod, missed.Name, dat );
        if missed.selection then
          nod.ImageIndex := 1;
        nod.SelectedIndex := nod.ImageIndex;
        old1 := nod;
        old2 := nod.parent;
        NotFound.Delete( pos-1 );
      end;
    end;
  end;
  NotFound.Destroy;
end;

function TIB_TreeView.FindNode( id: integer): tTreeNode;
var
  nnod: ttReeNode;
begin
  nnod := Self.Items.GetFirstNode;
  if Assigned( old1 ) and ( Integer( old1.Data^ ) = id )then
    nnod := old1
  else
  if Assigned( old2 ) and ( Integer( old2.Data^ ) = id )then
    nnod := old2
  else
  while Assigned( nnod ) and ( Integer( nnod.Data^ ) <> id ) do
    if nnod.HasChildren then
      nnod := nnod.GetFirstChild
    else
    begin
      while Assigned( nnod.parent ) and
            not Assigned( pointer( nnod.GetNextSibling )) do
        nnod := nnod.parent;
      nnod := nnod.GetNextSibling
    end;
  FindNode := nnod;
end;

procedure TIB_TreeView.SelectMe;
var
  nod: tTreeNode;
  val: integer;
begin
  if not Assigned( Selected )then
    exit;
  nod := nil;
  while FindNext( nod ) do
    if nod.ImageIndex = 2 then
    begin
      nod.ImageIndex := 1;
      nod.SelectedIndex := 1;
    end;
  val := 1 - Selected.ImageIndex;
  nod := nil;
  while FindNextChild( Selected, nod ) do
  begin
    nod.ImageIndex := val;
    nod.SelectedIndex := val;
  end;
  Repaint;
end;

procedure TIB_TreeView.DeleteMe;
var
  trash: ttreenode;
  nod: ttreenode;
  nextnode: ttreenode;
begin
  if not Assigned( Selected ) then
    exit;

  if not Assigned( Selected.Parent) then
    exit;

  trash := FindNode( TrashID );
  if Selected = Trash then
    exit;

  nextnode := selected;
  selected := selected.parent;
  nod := nil;

  if Assigned( FDeleteData ) and ( nextnode.parent = Trash ) then
  begin
    FDeleteData( Integer( nextnode.Data^ ));
    Items.Delete( nextnode );
  end
  else
  repeat
    nod := nil;
    while FindNextChild( nextnode, nod ) do
      if not nod.HasChildren then
      begin
        nod.MoveTo( Trash, naAddChild );
        if nod <> nextnode then
          nod := nil;
      end;
    Trash.Collapse( True );
  until nextnode.parent = Trash;
    
  while FindNext( nod ) do
    if nod.ImageIndex = 2 then
    begin
      nod.ImageIndex := 1;
      nod.SelectedIndex := 1;
    end;
  Move1.Enabled := false;
  Move1.Visible := false;
  Copy1.Enabled := false;
  Copy1.Visible := false;
end;

procedure TIB_TreeView.CutMe( Sender: TObject );
var
  nod: ttreenode;
  sel: boolean;
begin
  if not Assigned( Selected ) then
    exit;
  nod := nil;
  sel := Selected.SelectedIndex <> 2;
  while self.FindNext( nod ) do
  begin
    if nod.ImageIndex = 2 then
    begin
      nod.ImageIndex := 1;
      nod.SelectedIndex := 1;
    end;
  end;
  nod := nil;
  if sel then
  begin
    while FindNextChild(Selected,nod) do
    begin
      nod.ImageIndex := 2;
      nod.SelectedIndex := 2;
    end;
  end;
  Move1.Enabled := sel;
  Move1.Visible := sel;

  Copy1.Enabled := Move1.Enabled and FCopyEnable;
  Copy1.Visible := Move1.Visible and FCopyEnable;
  Repaint;
end;

function TIB_TreeView.FindNext( var nod: tTreeNode ): boolean;
begin
  if not Assigned( nod ) then
    nod := items.GetFirstNode
  else
  if nod.HasChildren then
    nod := nod.GetFirstChild
  else
  begin
    while Assigned( nod.parent ) and
          not Assigned( pointer( nod.GetNextSibling )) do
    begin
      nod := nod.parent;
    end;
    nod := nod.GetNextSibling;
  end;
  FindNext := Assigned( nod );
end;

function TIB_TreeView.FindNextChild(     parent: tTreeNode;
                                     var nod: tTreeNode ): boolean;
begin
  if not Assigned(nod) then
    nod := parent
  else
  if nod.HasChildren then
    nod := nod.GetFirstChild
  else
  begin
    while (nod <> parent)and not Assigned( pointer( nod.GetNextSibling )) do
    begin
      nod := nod.parent;
    end;
    if Nod = parent then
    begin
      FindNextChild := false;
      Exit;
    end;
    nod := nod.GetNextSibling
  end;
  FindNextChild := Assigned( nod );
end;

procedure TIB_TreeView.MoveMe( Sender: TObject );
var
  nod: ttreenode;
begin
  if not Assigned( Selected ) then
    exit;
  if selected.ImageIndex = 2 then
    exit;

  nod := nil;
  while FindNext( nod ) do
    if nod.ImageIndex = 2 then
      Break;
  if Assigned( nod ) then
    nod.MoveTo( Selected, naAddChild );
end;

procedure TIB_TreeView.SaveMe( Sender: TObject );
var
  nod: ttreenode;
begin
  nod := nil;
  if Assigned( FClearSelection ) then
    FClearSelection;
  if Assigned( FSaveSelection ) then
    while FindNext( nod ) do
      if nod.ImageIndex = 0 then
        SaveSelection( integer( nod.data^ ));
end;


procedure TIB_TreeView.RefreshMe( Sender: TObject );
begin
  Items.Clear;
  LoadData;
end;

procedure TIB_TreeView.InsertMe( Sender: TObject );
var
  master: integer;
  id: integer;
  ss: string;
  pin: pinteger;
  nod: ttreenode;
begin
  if Assigned( selected ) then
    master := Integer( Selected.Data^ )
  else
    master := RootID;
  ss := '';
  if Assigned( FNewData )then
    if FNewData( master, false, id ) then
      if Assigned( FChangeData )then
        if FChangeData( master, id, ss )then
        begin
          New( pin );
          pin^ := id;
          Selected := Items.AddChildObject( Selected, ss, pin );
          nod := nil;
          while FindNext( nod ) do
          if nod.ImageIndex = 2 then
          begin
            nod.ImageIndex := 1;
            nod.SelectedIndex := 1;
          end;
        end;
end;

procedure TIB_TreeView.ChangeMe( Sender: TObject );
var
  parent: integer;
  ss: string;
begin
  if not Assigned( Selected ) then
    exit;
  if Assigned( selected.parent ) then
    parent := Integer( Selected.parent.Data^ )
  else
    parent := RootID;
  ss := Selected.Text;
  if Assigned( FChangeData ) then
    if FChangeData( parent, Integer( Selected.Data^ ), ss ) then
      Selected.text := ss;
end;

procedure TIB_TreeView.SaveAll;
var
  nod: ttreenode;
  parent: integer;
begin
  nod := nil;
  if Assigned( FClearSelection ) then
    FClearSelection;
  if Assigned( FSaveData ) then
  begin
    while FindNext( nod ) do
    begin
      if Assigned( nod.parent ) then
        parent := Integer( nod.parent.Data^ )
      else
        parent := RootID;
      if Assigned( OnSaveData ) then
        OnSaveData( integer( nod.data^ ), parent );
    end;
  end;
end;

procedure TIB_TreeView.InsertUp;
var
  ss: string;
  parent: integer;
  id: integer;
  nod: ttreenode;
  pin: pinteger;
begin
  nod := selected;
  if Assigned(nod) then
    nod := nod.parent;
  if Assigned(nod) then
    parent := Integer(nod.Data^)
  else
    parent := RootID;
  ss := '';
  if Assigned(FNewData)then
    if FNewData(parent,false,id) then
      if Assigned(FChangeData) then
        if FChangeData(parent,id,ss) then
        begin
          New(pin);
          pin^ := id;
          Selected := Items.AddChildObject(nod,ss,pin);
          nod := nil;
          while FindNext(nod) do
            if nod.ImageIndex=2 then
            Begin
              nod.ImageIndex := 1;
              nod.SelectedIndex := 1;
            end;
        end;
end;

function  TIB_TreeView.GetCurrentID:integer;
begin
  if Assigned(Selected) then
    GetCurrentID := integer(Selected.data^)
  else
    GetCurrentID := -1;
End;

procedure TIB_TreeView.SetReadWrite( value: tReadWrite );
var
  nod: ttreenode;
begin
  fReadWrite := value;
  nod := nil;
  while FindNext( nod ) do
    if nod.ImageIndex = 2 then
    begin
      nod.ImageIndex := 1;
      nod.SelectedIndex := 1;
    end;
  if not (csDesigning in ComponentState) then
    case ReadWrite of
      modeRead:
        begin
          Cut1.Enabled := false;
          Delete1.Enabled := false;
          Change1.Enabled := false;
          Insert1.Enabled := false;
          Insert2.Enabled := false;

          Cut1.Visible := false;
          Delete1.Visible := false;
          Change1.Visible := false;
          Insert1.Visible := false;
          Insert2.Visible := false;

          Move1.Enabled := false;
          Move1.Visible := false;
          Copy1.Enabled := Move1.Enabled and FCopyEnable;
          Copy1.Visible := Move1.Visible and FCopyEnable;
        end;
      modeWrite:
        begin
          Cut1.Enabled := true;
          Delete1.Enabled := true;
          Change1.Enabled := true;
          Insert1.Enabled := true;
          Insert2.Enabled := true;

          Cut1.Visible := true;
          Delete1.Visible := true;
          Change1.Visible := true;
          Insert1.Visible := true;
          Insert2.Visible := true;
        end;
    end;
  Repaint;
end;

procedure TIB_TreeView.EnableCopy(value:boolean);
Begin
FCopyEnable := value;
if not (csDesigning in ComponentState) then Begin
   Copy1.Enabled := Move1.Enabled and FCopyEnable;
   Copy1.Visible := Move1.Visible and FCopyEnable;
   End;
End;

procedure TIB_TreeView.CopyMe( Sender: TObject );
var
  rootnod: ttreenode;
  nod: ttreenode;
  parentnode: ttreenode;
  oldnode: ttreenode;
  id: integer;
  pin: pinteger;
  name: string;
  autocopy: boolean;
begin
  autocopy := False;
  if not Assigned( Selected ) then
    exit;
  if selected.ImageIndex = 2 then
    exit;
    
  case MessageDlg( 'Copy. Are you shure?',
                   mtConfirmation,
                   [mbOk, mbAll, mbCancel], 0 )of
    mrOk: autocopy := false;
    mrAll: autocopy := true;
    mrCancel: exit;
  end;
  rootnod := nil;
  oldnode := nil;
  parentnode := selected;
  while FindNext( rootnod ) do
  begin
    if rootnod.ImageIndex = 2 then
      Break;
  end;
  nod := nil;
  if Assigned( FNewData ) then
  while FindNextChild( rootnod, nod ) do
  begin
    if Assigned( oldnode ) then
    begin
      while Assigned( oldnode.Parent ) do
      begin
        if oldnode = nod.Parent then
          Break
        else
        if oldnode.Parent = nod.Parent then
        begin
          parentnode := parentnode.Parent;
          oldnode := oldnode.Parent;
        end;
      end;
    end;
    if not FNewData( integer( parentnode.data^ ), true, id ) then
      Break;
    Name := nod.text;
    if Assigned( FCopyData ) then
      if not FCopyData( integer( nod.data^ ), id, Name ) then
        Break;
    if Assigned( FChangeData )and not autocopy then
      FChangeData( integer( parentnode.data^ ), id, Name );
    New( pin );
    pin^ := id;
    parentnode := Items.AddChildObject( parentnode, name, pin );
    parentnode.ImageIndex := 1;
    parentnode.SelectedIndex := 1;
    oldnode := nod;
  end;
end;

procedure TIB_TreeView.EnableSelection( value: boolean );
Begin
  FSelectEnable := Value;
  if not (csDesigning in ComponentState) then
  begin
    Select1.Enabled := FSelectEnable;
    Select1.Visible := FSelectEnable;
    Save1.Enabled := FSelectEnable;
    Save1.Visible := FSelectEnable;
  end;
end;

{
procedure Register;
begin
  RegisterComponents('iboControls', [TIB_TreeView]);
end;
}

end.
