📄 treedbed.pas
字号:
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 + -