unit System_PartNo;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, StdCtrls, Grids, DBGrids, ExtCtrls, ComCtrls, DB, ADODB,ShareData,
  DBCtrls;type
  TfmSystemPartNo = class(TForm)
    DataSource1: TDataSource;
    adoq: TADOQuery;
    TreeView1: TTreeView;
    Splitter1: TSplitter;
    GroupBox1: TGroupBox;
    PopupMenu1: TPopupMenu;
    pmAddPart: TMenuItem;
    N1: TMenuItem;
    Splitter2: TSplitter;
    Panel1: TPanel;
    DBNavigator1: TDBNavigator;
    DBGrid1: TDBGrid;
    adc: TADOCommand;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure adoqBeforeInsert(DataSet: TDataSet);
    procedure adoqAfterCancel(DataSet: TDataSet);
  private
    { Private declarations }
    FADOC:TADOConnection;
    FUserInfo:TUserInfo;
    FFrame:TFrame;
    FS_MainType,FS_SubType,FS_Vonder:Integer;
    procedure LoadData;
    procedure NextStep(sender:TObject);
    procedure PrevStep(sender:TObject);
    procedure LoadMainTypeFrame;
    procedure LoadSubTypeFrame;
    procedure LoadVonderFrame;
    procedure LoadItemFrame;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent;ADOC:TADOConnection;UserInfo:TUserInfo);
  end;var
  fmSystemPartNo: TfmSystemPartNo;implementation
uses frameSelectType,frameSelectSubType;
{$R *.dfm}{ TfmSystemPartNo }constructor TfmSystemPartNo.Create(AOwner: TComponent;
  ADOC: TADOConnection; UserInfo: TUserInfo);
var
  i:integer;
begin
  if adoc=nil then exit;
  FUserInfo:=UserInfo;
  inherited Create(AOwner);
  FADOC:=ADOC;
  adc.Connection:=FADOC;
  adoq.Connection:=FADOC;
  LoadData;
  for i:=0 to DBGrid1.Columns.Count -1 do
    DBGrid1.Columns[i].Width:=150;end;procedure TfmSystemPartNo.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
 self.Free;
end;procedure TfmSystemPartNo.LoadData;
begin
  if adoq.Active then Adoq.Close;
  AdoQ.Connection:=FADoc;adoq.SQL.Add('SELECT ITEM.ID AS 物料编码, item.namecn AS 名称, subtype.namecn AS 类型,');
  AdoQ.Connection:=FADoc;adoq.SQL.Add('item.format AS 规格, Vonder.NameCN AS 供应商');
  AdoQ.Connection:=FADoc;adoq.SQL.Add('FROM ITEM, Vonder, subtype');
  AdoQ.Connection:=FADoc;adoq.SQL.Add('WHERE (((Mid([item.id],4,3))=vonder.id) and (subtype.id=item.type))');
  //AdoQ.Connection:=FADoc;adoq.SQL.Add(' and item.id like '''+idStr+''';');
  //AdoQ.Connection:=FADoc;adoq.SQL.Add(' and item.namecn like '''+idStr+''';');
  Adoq.ExecSQL;
  adoq.Open;end;procedure TfmSystemPartNo.adoqBeforeInsert(DataSet: TDataSet);
begin
  LoadMainTypeFrame;end;procedure TfmSystemPartNo.adoqAfterCancel(DataSet: TDataSet);
begin  while GroupBox1.ControlCount>0 do
    GroupBox1.Controls[0].Free;end;procedure TfmSystemPartNo.NextStep(sender: TOBject);
var
  sel:Integer;
begin  if sender.ClassName ='TfrSelectType' then
  begin
    sel:=TfrSelectType(sender).ListBox1.ItemIndex;
    LoadSubTypeFrame;
    sender.Free;
  end;end;procedure TfmSystemPartNo.LoadItemFrame;
beginend;procedure TfmSystemPartNo.LoadMainTypeFrame;
var
  data:_Recordset;
begin  with TfrSelectType.Create(GroupBox1,NextStep) do
  begin
    Align:=alClient;
    Visible:=true;
    Parent:=GroupBox1;    adc.CommandText:='select namecn from type order by id';
    data:=adc.Execute;
    while not  data.EOF do
    begin
      ListBox1.Items.Add(data.Fields.Item['namecn'].Value);
      data.MoveNext;
    end;
    data.Close;
  end;
end;procedure TfmSystemPartNo.LoadSubTypeFrame;
begin
  with TfrSelectSubType.Create(GroupBox1,NextStep,PrevStep) do
  begin
   Align:=alClient;
   Visible:=true;
   Parent:=GroupBox1;
  end;
end;procedure TfmSystemPartNo.LoadVonderFrame;
beginend;procedure TfmSystemPartNo.PrevStep(sender: TObject);
var
  sel,i:Integer;
begin  if sender.ClassName ='TfrSelectSubType' then
  begin
    sel:=TfrSelectSubType(sender).ListBox1.ItemIndex;
    LoadMainTypeFrame;
    sender.Free;
  end;
  showmessage('OK');这一行不加就出错,加上就没事了
end;end.

解决方案 »

  1.   

    是很奇怪.你可能加个else也不会出错吧
      

  2.   

    用Sender.Release代替Sender.Free (你的TfrSelectSubType应该是个TForm继承类吧?)Form.Free立即释放相关内存。 而Form.Release则不会立即释放内存而是等其内部(及所有子component)所有被调用的过程/函数都结束后才释放内存。 所以用Form.Free可能存在陷阱,比如一个事件或者override的方法执行到中途时调用了free释放了内存,等事件返回后继续执行原来的内部方法时或者被override的方法继续执行inherited部分时可能访问已经被释放掉的内存而引起错误。
      

  3.   

    TfrSelectSubType,TfrSelectType都是从TFrame继承类的,相当如一个控件在使用,就像一个向导对话框一样,在选的中下一步的时候释放掉当前控件,载入下一个控件,上一步的时候,释放掉当前控件,载入上一个按件。但出错不是在第一次运行的时候,是在选 下一步 再 上一步 再  下一步 的再上一步的时候出错TfrSelectType ->下一步 
    载入 TfrSelectSubType ->上一步
    载入 TfrSelectType ->下一步 
    载入 TfrSelectSubType (在这里出错)
      

  4.   

    少打了几个字
    TfrSelectSubType,TfrSelectType都是从TFrame继承类的,相当如一个控件在使用,就像一个向导对话框一样,在选的中下一步的时候释放掉当前控件,载入下一个控件,上一步的时候,释放掉当前控件,载入上一个按件。但出错不是在第一次运行的时候,是在选  下一步  再  上一步  再    下一步  的再上一步的时候出错  
     
    TfrSelectType  -  >下一步    
    载入  TfrSelectSubType  -  >上一步  
    载入  TfrSelectType  -  >下一步    
    载入  TfrSelectSubType -  >上一步   (在这里出错)