Дублирование фрэйма

morebeauty · #1 20.11.2012, 13:31

Есть MDI приложение. В нем есть форма справочников. Форма одна, в ней фрэйм. В зависимости от переданного параметра фрэйм берет с базы и отображает/изменяет нужную инфу. Отвечает за это созданный во фрейме класс, компонент TreeView и функциональные кнопочки. Есть возможность открыть форму справочника многократно. При этом активным получается TreeView в последней открытой форме. То есть при попытке обратиться к TreeView.Selected, программа получает активную TTreeNode в последней открытой форме, вместо активной формы. Как это можно избежать?

В главной форме:

Код:

procedure TfrmMain.N7Click(Sender: TObject);
begin
  OpenDirectory(1);
end;

procedure TfrmMain.N6Click(Sender: TObject);
begin
  OpenDirectory(0);
end;

procedure TfrmMain.OpenDirectory(Cat: Integer);
var
  fd:TfrmDir;
begin
  fd:=TfrmDir.Create(self,cat);
end;

В открываемой форме:

Код:

constructor TfrmDir.Create(AOwner: TComponent; CatID: Integer);
begin
  Dir:=CatID;
  inherited Create(AOwner);
end;

procedure TfrmDir.FormShow(Sender: TObject);
begin
  OpenDir(dir);
end;
procedure TfrmDir.OpenDir(DirID: Integer);
begin
  frmCat1.ActivateFrame(catdir[DirID].CatID,false);
end;

Во фрэйме:

Код:

procedure TfrmCat.ActivateFrame(CatID:Integer;ViewID:boolean);
begin
  catsys:=TCatSystem.Create;
  CatSys.Connection:=Module.ADOCon;
  CatSys.CatTableName:='tCatSystem';
  CatSys.ID:='ID';
  CatSys.CatName:='CatName';
  CatSys.CatParent:='CatParent';
  CatSys.RootCat:=CatID;
  CatSys.ShowCatID:=ViewID;
  CatSys.TV:=tv1;
  CatSys.FeelingTree;
end;

poli-smen · #2 20.11.2012, 13:43

Цитата:

Сообщение от morebeauty

То есть при попытке обратиться к TreeView.Selected, программа получает активную TTreeNode в последней открытой форме, вместо активной формы. Как это можно избежать?

А где в приведённых кусках кода обращение к TreeView.Selected?
Что такое и где объявлено "frmCat1" и "CatSys"?

morebeauty · #3 20.11.2012, 13:48

Цитата:

А где в приведённых кусках кода обращение к TreeView.Selected?
Что такое и где объявлено "frmCat1" и "CatSys"?

Думаю не в этом собака зарыта, но...

В коде фрэйма:

Код:

procedure TfrmCat.btn1Click(Sender: TObject);
var
  SelID:integer;
begin
  //ShowMessage(Self.name + ' ' + IntToStr(CatSys.RootCat) + ' ' + CatSys.TV.Selected.Text);
  if CatSys.TV.Selected<>nil then
  begin
    selid:=Integer(CatSys.TV.Selected.Data);
    CatSys.CreateNewCat('123',SelID);
  end;

end;

procedure TfrmCat.btn4Click(Sender: TObject);
var
  selid:Integer;
begin
  if CatSys.TV.selected<>nil then
  begin
    selid:=Integer(CatSys.TV.Selected.Data);
    CatSys.DeleteCatByID(selid);
  end;
end;

В отдельном юните:

Код:

unit DBCatSystem;

interface

uses
  Variants, Classes, DB, ADODB, ComCtrls, SysUtils, Dialogs;
type
  TCatSystem = class
  private
    FConnection:TADOConnection;
    FCatTableName:string;
    FFieldID:string;
    FFieldCatName:string;
    FFieldCatParent:string;
    FRootCat:Integer;
    FTreeView:TTreeView;
    FShowCatID:Boolean;
    procedure AddTreeNode(Parent:TTreeNode;IDNODE:Integer);
    procedure NotConnected;
  public
    property Connection:TADOConnection read FConnection write FConnection;
    property CatTableName:string read FCatTableName write FCatTableName;
    property ID:string read FFieldID write FFieldID;
    property CatName: string read FFieldCatName write FFieldCatName;
    property CatParent: string read FFieldCatParent write FFieldCatParent;
    property RootCat: Integer read FRootCat write FRootCat;
    property TV:TTreeView read FTreeView write FTreeView;
    property ShowCatID:Boolean read FShowCatID write FShowCatID;
    procedure FeelingTree;
    function GetCatNameByID (CatID:Integer):string;
    procedure RenameCatByID (CatID:Integer;NewName:string);
    procedure DeleteCatByID (CatID:integer);
    function HasChilds (CatID:Integer):Boolean;
    function GetTreeNodeByID(CatID:Integer):TTreeNode;
    procedure CreateNewCat(NewCatName:string;ParentID:Integer);
    function GetChildsIDs(CatID:Integer):TStringList;
  end;
implementation

{ TCatSystem }

procedure TCatSystem.AddTreeNode(Parent: TTreeNode; IDNODE: Integer);
var
  RS:_Recordset;
  SQLStr:string;
  TmpTN:TTreeNode;
  TmpStr:string;
  TmpInt:integer;
  CatIDLabel:string;
begin
  if Connection.Connected=False then
  begin
    NotConnected;
    Exit;
  end;
  SQLStr:='SELECT ' + CatName + ' FROM ' + CatTableName +
  ' WHERE ' + ID + '=' + IntToStr(IDNODE);
  rs:=Connection.Execute(SQLStr);
  if RS.RecordCount=1 then
  begin
    //SetLength(CatIDs,Length(CatIDs)+1);
    //CatIDs[High(catids)]:=ID;
    if ShowCatID then CatIDLabel:=' (' + IntToStr(IDNODE) + ')' else CatIDLabel:='';
    TmpStr:=VarToStr(RS.Fields.Item[CatName].Value) + CatIDLabel;
    tmptn:=TV.Items.AddChildObject(Parent,TmpStr,Pointer(IDNODE));
    TmpTN.SelectedIndex:=1;
    SQLStr:='SELECT ' + ID + ' FROM ' + CatTableName +
    ' WHERE ' + CatParent + '=' + IntToStr(IDNODE);
    rs:=Connection.Execute(SQLStr);
    if RS.RecordCount>0 then
    begin
      rs.MoveFirst;
      while not RS.EOF do
      begin
        tmpint:=Integer(RS.Fields.Item[ID].Value);
        AddTreeNode(TmpTN,TmpInt);
        RS.MoveNext;
      end;
    end;
    //tmptn:=TTreeNode.Create();

  end;
end;

procedure TCatSystem.CreateNewCat(NewCatName: string;ParentID:Integer);
var
  SQLStr:string;
begin
  if Connection.Connected=False then
  begin
    NotConnected;
    Exit;
  end;
  SQLStr:='INSERT INTO ' + CatTableName + ' (' + CatName + ', ' +
  CatParent + ') VALUES (' + QuotedStr(NewCatName) + ', ' +
  QuotedStr(IntToStr(ParentID)) + ')';
  Connection.Execute(SQLStr);
  if TV<>nil then
  begin
    TV.Items.AddChild(GetTreeNodeByID(ParentID),NewCatName);
  end;
end;

procedure TCatSystem.DeleteCatByID(CatID: integer);
var
  RS:_Recordset;
  SQLStr:string;
  TmpInt:integer;
  I:Integer;
begin
  if CatID=RootCat then
  begin
    Exit;
  end;
  if Connection.Connected=False then
  begin
    NotConnected;
    Exit;
  end;
  sqlstr:='SELECT ' + ID + ' FROM ' + CatTableName +
  ' WHERE ' + CatParent + '=' + IntToStr(CatID);
  rs:=Connection.Execute(SQLStr);
  if rs.RecordCount>0 then
  begin
    rs.MoveFirst;
    while not rs.EOF do
    begin
      TmpInt:=Integer(RS.Fields[0].Value);
      DeleteCatByID(TmpInt);
      rs.MoveNext;
    end;
  end;
  if TV<>nil then TV.Items.Delete(GetTreeNodeByID(CatID));
  SQLStr:='DELETE FROM ' + CatTableName + ' WHERE ' + ID + '=' + IntToStr(CatID);
  Connection.Execute(SQLStr);
end;

procedure TCatSystem.FeelingTree;
begin
  if Connection.Connected=False then
  begin
    NotConnected;
    Exit;
  end;
  if TV<>nil then
  begin
    TV.Items.Clear;
    AddTreeNode(nil,RootCat);
  end;
end;

function TCatSystem.GetCatNameByID(CatID: Integer): string;
var
  SQLStr:string;
  RS:_Recordset;
begin
  if Connection.Connected=False then
  begin
    NotConnected;
    Exit;
  end;
  result:='';
  SQLStr:='SELECT ' + CatName + ' FROM ' + CatTableName + ' WHERE ' + ID + '=' + IntToStr(CatID);
  rs:=Connection.Execute(SQLStr);
  if rs.RecordCount=1 then
  begin
    result:=VarToStr(RS.Fields[0].Value);
  end;
end;

function TCatSystem.GetChildsIDs(CatID: Integer): TStringList;
var
  SQLStr:string;
  RS:_Recordset;
begin
  if Connection.Connected=False then
  begin
    NotConnected;
    Exit;
  end;
  SQLstr:='SELECT ' + ID + ' FROM ' + CatTableName + ' WHERE ' +
  CatParent + '=' + IntToStr(CatID);
  rs:=Connection.Execute(SQLStr);
  if RS.RecordCount>0 then
  begin
    RS.MoveFirst;
    while not rs.EOF do
    begin
      Result.Add(RS.Fields[0].Value);
    end;
  end;
end;

function TCatSystem.GetTreeNodeByID(CatID: Integer): TTreeNode;
var
  i:Integer;
  TmpInt:Integer;
begin
  if Connection.Connected=False then
  begin
    NotConnected;
    Exit;
  end;
  result:=nil;
  for i:=0 to TV.Items.Count-1 do
  begin
    tmpint:=Integer(tv.Items.Item[i].Data);
    if CatID=TmpInt then
    begin
      result:=tv.Items.Item[i];
      Break;
    end;
  end;
end;

function TCatSystem.HasChilds(CatID: Integer): Boolean;
var
  RS:_Recordset;
  SQLStr:string;
begin
  if Connection.Connected=False then
  begin
    NotConnected;
    Exit;
  end;
  SQLStr:='SELECT Count(' + ID + ') FROM ' + CatTableName + ' WHERE ' +
  CatParent + '=' + IntToStr(CatID);
  rs:=Connection.Execute(SQLStr);
  if Integer(rs.Fields[0].Value)<>0 then result:=True else result:=False;
end;

procedure TCatSystem.NotConnected;
begin
  MessageDlg('Íåò ïîäêëþ÷åíèÿ!',mtError,[mbOK],0);
end;

procedure TCatSystem.RenameCatByID(CatID: Integer; NewName: string);
var
  SQLStr:string;
begin
  if Connection.Connected=False then
  begin
    NotConnected;
    Exit;
  end;
  SQLStr:='UPDATE ' + CatTableName + ' SET ' + CatName + '=' + NewName +
  ' WHERE ' + ID + '=' + IntToStr(CatID);
  Connection.Execute(SQLStr);
  if TV<>nil then
  begin
    GetTreeNodeByID(CatID).Text:=NewName;
  end;
end;

end.

poli-smen · #4 20.11.2012, 13:51

Цитата:

Сообщение от morebeauty

Думаю не в этом собака зарыта, но...

И здесь нет обращения к TreeView.Selected

morebeauty · #5 20.11.2012, 13:52

Как нет? В коде фрэйма!

poli-smen · #6 20.11.2012, 13:57

Цитата:

Сообщение от morebeauty

Как нет? В коде фрэйма!

Понятно. Значит вот это оно "CatSys.TV.Selected". А где объявление CatSys ?

morebeauty · #7 20.11.2012, 13:59

Ну если любите много читать... )

Начало кода фрэйма:

Код:

unit FrameCat;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ImgList, acAlphaImageList, ComCtrls, ToolWin, Module1, DBCatSystem;

type
  TfrmCat = class(TFrame)
    tv1: TTreeView;
    tlb1: TToolBar;
    btn1: TToolButton;
    il1: TsAlphaImageList;
    btn2: TToolButton;
    btn3: TToolButton;
    btn4: TToolButton;
    il2: TsAlphaImageList;
    procedure btn3Click(Sender: TObject);
    procedure btn1Click(Sender: TObject);
    procedure btn4Click(Sender: TObject);
  private
    { Private declarations }
  public
    Cat:Integer;
    procedure ActivateFrame(CatID:Integer;ViewID:boolean);
    { Public declarations }
  end;
var
  CatSys:TCatSystem;

poli-smen · #8 20.11.2012, 14:02

Цитата:

Сообщение от morebeauty

Ну если любите много читать... )

Начало кода фрэйма:

Код:

unit FrameCat;

interface
.....
var
  CatSys:TCatSystem;

Ну вот и ответ. CatSys это глобальная переменная. Одна единственная на всё приложение. В ней может храниться только один, последний созданный объект класса TCatSystem.

morebeauty · #9 20.11.2012, 14:53

Тогда как ее сделать доступной лишь в форме? Ну, типа для доступа к ней лишь внутри формы (но не в отдельной процедуре). Вшить ее в класс формы? Если есть несколько решений, подскажите все пожалуйста.

poli-smen · #10 20.11.2012, 14:58

Цитата:

Сообщение от morebeauty

Тогда как ее сделать доступной лишь в форме? Ну, типа для доступа к ней лишь внутри формы (но не в отдельной процедуре). Вшить ее в класс формы?

Именно так. Переменных CatSys должно быть столько же, сколько и фреймов (у каждого фрейма своя), значит CatSys должна быть не глобальной переменной, а полем у класса фрейма TfrmCat.

Опции темы	Поиск в этой теме
Версия для печати Отправить на Email	Поиск в этой теме: Расширенный поиск
Опции просмотра
Линейный вид Комбинированный вид Древовидный вид

	Сайт	Форум	FAQ	RSS лента	Прочее
	Новости Исходники Компоненты Статьи Добавить исходник Поиск	Правила Поиск Сообщения за сегодня Пользователи Кто на форуме?	Delphi FAQ - 5000 статей DRKB - 4500 статей (ZIP-архив) Справочник функций и процедур Delphi Delphi Programming Guide Indy in Depth. Глубины Indy	Новости сайта Новости форума	Ссылки и Баннеры Donate О сайте Реклама Контакты

Этот пользователь сказал Спасибо poli-smen за это полезное сообщение:
morebeauty (20.11.2012)