⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 treedbed.pas

📁 TeeChart 7.0 With Source在Delphi 7.0中的安装
💻 PAS
📖 第 1 页 / 共 2 页
字号:

  FillDataSets(CBDataSet.Items,RadioButton3.Checked,nil);

  if Assigned(ADataSet) then
  begin
    CBDataSet.ItemIndex:=CBDataSet.Items.IndexOfObject(ADataSet);
    CBDataSetChange(Self);
    if ACodeField<>'' then
       ComboBox2.ItemIndex:=ComboBox2.Items.IndexOf(ACodeField);
    SetComboIndex(ComboBox3,AParentField);
    SetComboIndex(ComboBox4,ATextFields);
  end;

  if Assigned(ADetail) then
  begin
    ComboBox5.ItemIndex:=ComboBox5.Items.IndexOfObject(ADetail);
    ComboBox5Change(Self);
    SetComboIndex(ComboBox6,ADetailFields);
  end;
end;

procedure TFormDBTree.Button1Click(Sender: TObject);
begin
  if Panel3.Visible then
  begin
    if BApply.Enabled then BApplyClick(Self);
    ModalResult:=mrOk;
  end
  else FillControls;
end;

procedure TFormDBTree.Button2Click(Sender: TObject);
begin
  TreePreview.Visible:=True;
  Panel3.Visible:=False;
  Panel3.SendToBack;
  Panel4.Visible:=True;
  Panel4.BringToFront;
  Panel4.Align:=alClient;
  Button1.Caption:=TreeMsg_Next;
  Button2.Enabled:=False;
end;

Procedure TFormDBTree.FillFields(tmpDataSet:TDataSet; AItems:TStrings; OnlyNumeric:Boolean);

  Function IsNumber(AField:TFieldType):Boolean;
  begin
    Case AField of
      ftSmallint,
      ftInteger,
      ftWord,
      ftFloat,
      ftCurrency,
      ftBCD,
      ftAutoInc: result:=True;
    else result:=False;
    end;
  end;

Var t : Integer;
Begin
  AItems.Clear;
  With tmpDataSet do
  begin
    if FieldCount>0 then
       for t:=0 to FieldCount-1 do
       begin
         if (not OnlyNumeric) or IsNumber(Fields[t].DataType) then
            AItems.AddObject(Fields[t].FieldName,Fields[t])
       end
    else
    begin
      FieldDefs.Update;
      for t:=0 to FieldDefs.Count-1 do
         if (not OnlyNumeric) or IsNumber(FieldDefs[t].DataType) then
             AItems.AddObject(FieldDefs[t].Name,FieldDefs[t]);
    end;
  end;
end;

procedure TFormDBTree.CBDataSetChange(Sender: TObject);
begin
  if (CBDataSet.Text<>'') and (CBDataSet.ItemIndex>=0) then
  begin
    ADataSet:=TDataSet(CBDataSet.Items.Objects[CBDataSet.ItemIndex]);
    FillFields(ADataSet,ComboBox2.Items,True);
    FillFields(ADataSet,ComboBox3.Items,RadioButton1.Checked);
    FillFields(ADataSet,ComboBox4.Items,False);
    if ComboBox5.Visible then FillDataSets(ComboBox5.Items,False,ADataSet);
  end
  else ADataSet:=nil;
  Changed;
end;

Procedure TFormDBTree.FillDataSets(AItems:TStrings; MastersOnly:Boolean; AMaster:TDataSet);
var tmpList : {$IFDEF CLR}TObjectList{$ELSE}TList{$ENDIF};

  Procedure FillSourcesForm(AOwner:TComponent; AItems:TStrings);

    Function IsDetailDataSet(SomeDataSet:TDataSet):Boolean;
    begin
      result:=Assigned(tmpList) and (tmpList.IndexOf(SomeDataSet)<>-1);
    end;

  var t   : Longint;
      tmp,
      tmpFormName:String;
  begin
    With AOwner do
    for t:=0 to ComponentCount-1 do
    if Components[t] is TDataSet then
    if (not Assigned(AMaster)) or IsDetailDataSet(TDataSet(Components[t])) then
    With Components[t] do
    begin
       tmp:=Name;
       if (Tree1.Owner<>Owner) and Assigned(Owner) then
       begin
         tmpFormName:=Owner.Name;
         if tmpFormName<>'' then tmp:=tmpFormName+'.'+tmp;
       end;
       AItems.AddObject(tmp,AOwner.Components[t]);
    end;
  end;

var t : Integer;
begin
  AItems.Clear;

  if Assigned(AMaster) then
  begin
    tmpList:={$IFDEF CLR}TObjectList{$ELSE}TList{$ENDIF}.Create;
    AMaster.GetDetailDataSets(tmpList);
  end
  else tmpList:=nil;

  With Screen do
    for t:=0 to DataModuleCount-1 do FillSourcesForm(DataModules[t], AItems);
  if Assigned(Tree1.Owner) then FillSourcesForm(Tree1.Owner, AItems);

  tmpList.Free;
end;

procedure TFormDBTree.ComboBox5Change(Sender: TObject);
begin
  if (ComboBox5.Text<>'')  and (ComboBox5.ItemIndex>=0) then
  begin
    ADetail:=TDataSet(ComboBox5.Items.Objects[ComboBox5.ItemIndex]);
    FillFields(ADetail,ComboBox6.Items,False);
  end
  else ADetail:=nil;
  Changed;
end;

procedure TFormDBTree.ComboBox2Change(Sender: TObject);
begin
  if (ComboBox2.Text<>'')  and (ComboBox2.ItemIndex>=0) then
     ACodeField:=ComboBox2.Items[ComboBox2.ItemIndex]
  else
     ACodeField:='';
  Changed;
end;

procedure TFormDBTree.ComboBox3Change(Sender: TObject);
begin
  AParentField:=ComboBox3.Text;
  Changed;
end;

procedure TFormDBTree.ComboBox4Change(Sender: TObject);
begin
  ATextFields:=ComboBox4.Text;
  Changed;
end;

procedure TFormDBTree.ComboBox6Change(Sender: TObject);
begin
  ADetailFields:=ComboBox6.Text;
  Changed;
end;

procedure TFormDBTree.BApplyClick(Sender: TObject);

  Procedure RaiseExceptionField(AControl:TWinControl; Const AMessage:String);
  begin
    AControl.SetFocus;
    Raise Exception.Create(AMessage);
  end;

var tmp:TTreeNodeShape;
begin
  if Assigned(ADataSet) then
  begin
     if RadioButton1.Checked then
     begin
        if ACodeField='' then RaiseExceptionField(ComboBox2,TreeMsg_DBCodeNeeded);
        if AParentField='' then RaiseExceptionField(ComboBox3,TreeMsg_DBCodeNeeded);
        if ATextFields='' then RaiseExceptionField(ComboBox4,TreeMsg_DBCodeNeeded);
     end;
     if RadioButton2.Checked then
        if ATextFields='' then
           RaiseExceptionField(ComboBox4,TreeMsg_DBTextNeeded);
     if RadioButton3.Checked then
     begin
        if ATextFields='' then RaiseExceptionField(ComboBox4,TreeMsg_MasterNeed);
        if (not Assigned(ADetail)) or (ADetailFields='') then
           RaiseExceptionField(ComboBox6,TreeMsg_DetailNeed);
     end;
  end;
  With Tree1 do
  begin
    DataSet      :=ADataSet;
    CodeField    :=ACodeField;
    ParentField  :=AParentField;
    TextFields   :=ATextFields;
    Detail       :=ADetail;
    DetailFields :=ADetailFields;
    MultiLineText:=CheckBox1.Checked;

    if Layout.Count>0 then
    begin
      Layout[0].Format.Assign(AFormatMaster);
      Layout[0].HeaderFormat.Assign(AHeaderMaster);

      if Layout.Count>2 then
      begin
        Layout[1].Format.Assign(AFormatDetail);
        Layout[1].HeaderFormat.Assign(AHeaderDetail);
      end;
    end;

    Screen.Cursor:=crHourGlass;
    try
      Refresh;
    finally
      Screen.Cursor:=crDefault;
    end;

    { Expand first Root... }
    if Roots.Count>0 then
    begin
      tmp:=Roots[0];
      Repeat
        tmp.Expanded:=True;
        if tmp.Childs.Count>0 then
           tmp:=tmp.Childs[0]
        else
           tmp:=nil;
      Until not Assigned(tmp);
    end;         
  end;
  BApply.Enabled:=False;
end;

Procedure TFormDBTree.Changed;
begin
  BApply.Enabled:=True;
end;

Function ChooseFields( Const AText:String; AItems:TStrings;
                       Const ACaption:String):String;

  Function SeparateItems(SomeItems:TStrings):String;
  var t : Integer;
  begin
    result:='';
    if SomeItems.Count>0 then
    begin
      result:=SomeItems[0];
      for t:=1 to SomeItems.Count-1 do
          result:=result+TreeMsg_FieldSeparator+SomeItems[t];
    end;
  end;

var t,
    tmpIndex : Integer;
    tmpSt    : String;
    s        : TSelectListForm;
    tmp      : TPanel;
    b        : TButton;
    c        : TButton;
begin
  result:=AText;
  s:=TSelectListForm.Create(nil);
  with s do
  try
    Caption:=ACaption;
    Align:=alNone;
    BorderStyle:=TeeBorderStyle;
    Position:=poScreenCenter;
    Height:=300;
    Width:=400;

    FromList.Items.Assign(AItems);
    if AText<>'' then
    begin
      for t:=1 to TeeNumFields(AText) do
      begin
        tmpSt:=TeeExtractField(AText,t);
        tmpIndex:=FromList.Items.IndexOf(tmpSt);
        if tmpIndex<>-1 then
        begin
          ToList.Items.Add(tmpSt);
          FromList.Items.Delete(tmpIndex);
        end;
      end;
    end;

    tmp:=TPanel.Create(s);
    with tmp do
    begin
      Align:=alBottom;
      Caption:='';
      Parent:=s;
    end;
    b:=TButton.Create(s);
    with b do
    begin
      Left:=s.Width-186;
      Top:=6;
      Caption:='OK';
      Parent:=tmp;
      ModalResult:=mrOk;
      Default:=True;
    end;

    c:=TButton.Create(s);
    with c do
    begin
      Left:=s.Width-90;
      Top:=6;
      Caption:='Cancel';
      Parent:=tmp;
      ModalResult:=mrCancel;
      Cancel:=True;
    end;

    if ShowModal=mrOk then
       result:=SeparateItems(ToList.Items);
  finally
    Free;
  end;
end;

procedure TFormDBTree.Button7Click(Sender: TObject);
begin
  With ComboBox3 do Text:=ChooseFields(Text,Items,Label4.Caption);
  ComboBox3Change(Sender);
end;

procedure TFormDBTree.Button4Click(Sender: TObject);
begin
  With ComboBox4 do Text:=ChooseFields(Text,Items,Label5.Caption);
  ComboBox4Change(Sender);
end;

procedure TFormDBTree.Button5Click(Sender: TObject);
begin
  With ComboBox6 do Text:=ChooseFields(Text,Items,Label7.Caption);
  ComboBox6Change(Sender);
end;

procedure TFormDBTree.CheckBox1Click(Sender: TObject);
begin
  Changed;
end;

procedure TFormDBTree.OnShowEditor(Sender:TObject);
begin
  with TNodeTreeEditor(Sender) do
  begin
    ShowControls(False,[Label22,CBConnStyle,CheckBox8,Label20,ComboBox5]);
  end;
end;

procedure TFormDBTree.EditShape(AShape:TTreeNodeShape);
begin
  InternalEditTreeShapePage(nil,AShape,stFormat,False,OnShowEditor);
  Changed;
end;

procedure TFormDBTree.Button6Click(Sender: TObject);
begin
  EditShape(AFormatMaster);
end;

procedure TFormDBTree.Button8Click(Sender: TObject);
begin
  EditShape(AHeaderMaster);
end;

procedure TFormDBTree.Button9Click(Sender: TObject);
begin
  EditShape(AFormatDetail);
end;

procedure TFormDBTree.Button10Click(Sender: TObject);
begin
  EditShape(AHeaderDetail);
end;

procedure TFormDBTree.FormDestroy(Sender: TObject);
begin
  AFormatMaster.Free;
  AFormatDetail.Free;
  AHeaderMaster.Free;
  AHeaderDetail.Free;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -