L2_pas
unit F_FldDlg;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, DbItf, Db, DbTables, Clipper, TypInfo, MnT, Buttons, DbItfT,
Globs;
Type
TFldDlgFr = class (TForm)
FldNameLbl: TLabel;
FldCaptionLbl: TLabel;
FldDescrLbl: TLabel;
FldDataTypeLbl: TLabel;
Label5: TLabel;
FldNameEdit: TEdit;
FldCaptionEdit: TEdit;
FldDescrEdit: TEdit;
OkBtn: TButton;
CancelBtn: TButton;
FldSizeEdit: TEdit;
TypeGroupCmBox: TComboBox;
TypesComboBox: TComboBox;
Label1: TLabel;
Procedure FormCreate(Sender: TObject);
Procedure CancelBtnClick(Sender: TObject);
Procedure FormActivate(Sender: TObject);
Procedure OkBtnClick(Sender: TObject);
Procedure FldNameEditKeyUp(Sender: TObject; Var Key: Word;
Shift: TShiftState);
procedure TypeGroupCmBoxChange(Sender: TObject);
procedure TypesComboBoxKeyPress(Sender: TObject; var Key: Char);
procedure TypesComboBoxClick(Sender: TObject);
procedure FldSizeEditKeyPress(Sender: TObject; var Key: Char);
private
FModalRes : Boolean;
FpTFbCommonType : pTFbCommonType;
FTFbTypeGroup : TFbTypeGroup;
FTFieldType : TFieldType;
FDbInterface : TDbInterface;
procedure SetTypeGroupLayout(ffTFbTypeGroup: TFbTypeGroup);
procedure Set_FDbInterface(const Value: TDbInterface);
public
Function Execute : Bool;
published
Property DbInterface : TDbInterface read FDbInterface write Set_FDbInterface;
end;
Var
FldDlgFr: TFldDlgFr;
implementation
uses F_TbDef;
{$R *.DFM}
procedure TFldDlgFr.Set_FDbInterface(const Value: TDbInterface);
Var
wTFbTypeGroup : TFbTypeGroup;
begin
FDbInterface := Value;
// Настройка списка групп данных
TypeGroupCmBox.Items.Clear;
for wTFbTypeGroup := Low(TFbTypeGroup) to High(TFbTypeGroup) do
TypeGroupCmBox.Items.AddObject(apTypeGroupNames[wTFbTypeGroup],
TObject(wTFbTypeGroup));
// Выбираем первую группу в списке групп данных
TypeGroupCmBox.ItemIndex := 0;
wTFbTypeGroup := TFbTypeGroup(TypeGroupCmBox.Items.Objects[0]);
// Заполнить универсальный список списком выбранного комб. типа
UpdateFieldTypesN(FDbInterface, TypesComboBox, wTFbTypeGroup);
SetTypeGroupLayout(wTFbTypeGroup);
FpTFbCommonType := nil; // с этого начинаем конкретную работу
end;
Procedure TFldDlgFr.FormCreate(Sender: TObject);
Var
k : Integer;
begin
for k:=0 to ComponentCount-1 do
if TComponent(Components[k]) is TEdit then
TEdit(Components[k]).Clear;
TypesComboBox.Text := '';
FldSizeEdit.Text := '10';
end;
Procedure TFldDlgFr.CancelBtnClick(Sender: TObject);
begin
FModalRes := False;
Close;
end;
Procedure TFldDlgFr.FormActivate(Sender: TObject);
Var
k, i : Integer;
wpTTableInfo : pTTableInfo;
wspTFieldInfo : pTFieldInfo;
wpTFbCommonType : pTFbCommonType;
wTFbTypeGroup : TFbTypeGroup;
wCaptionUnique : Boolean;
wFieldDescr : String;
begin
if FDbInterface = nil then
begin
FbKernelWarning('FDbInterface = nil');
Exit;
end;
if TypesComboBox.Text = '' then
TypesComboBox.Text := 'Тип данных';
if FDbInterface.N_pTFieldInfo = nil then
Exit;
{ В дальнейшем все действия - только с FpTFbCommonType }
FldNameEdit.Text := FDbInterface.N_pTFieldInfo.sFieldAttr.Values['sFieldName'];
if TrimF(FldNameEdit.Text) <> '' then
begin
FldDescrEdit.Text := FDbInterface.N_pTFieldInfo.sFieldAttr.Values['sFieldDescr'];
FldCaptionEdit.Text := FDbInterface.N_pTFieldInfo.sFieldAttr.Values['sFieldCaption'];
FldSizeEdit.Text := IntToStr(FDbInterface.N_pTFieldInfo.sFieldSize);
end
else
// Если имя поля оказалось не заданным - предлагаем его
begin
if TbDefFr = nil then
FldNameEdit.Text := FDbInterface.Get_UniqueFieldName(
FDbInterface.Current_pTTableInfo, nil, wCaptionUnique, wFieldDescr)
else
FldNameEdit.Text := FDbInterface.Get_UniqueFieldName(
FDbInterface.Current_pTTableInfo, TbDefFr.TbFieldsListBox.Items,
wCaptionUnique, wFieldDescr);
if TrimF(FldCaptionEdit.Text) = '' then
FldCaptionEdit.Text := FldNameEdit.Text;
if TrimF(FldDescrEdit.Text) = '' then
FldDescrEdit.Text := wFieldDescr;
end;
{ Выставка индекса в ComboBox в соответствии с типом поля }
wpTFbCommonType := nil;
{ Определение группы данных по информации в FDbInterface.N_pTFieldInfo }
wTFbTypeGroup := Get_TFbTypeGroup(FDbInterface.N_pTFieldInfo);
k := TypeGroupCmBox.Items.IndexOf(apTypeGroupNames[wTFbTypeGroup]);
TypeGroupCmBox.ItemIndex := k;
case wTFbTypeGroup of
FldGroup :
// Выставка в ComboBox индекса базового типа
begin
TypesComboBox.Text := 'Нет в СИСТЕМЕ ';
for i := 0 to TypesComboBox.Items.Count-1 do
begin
wpTFbCommonType := pTFbCommonType(TypesComboBox.Items.Objects[i]);
if wpTFbCommonType.FbFld.sType = FDbInterface.N_pTFieldInfo.sFieldType then
begin
TypesComboBox.ItemIndex := i;
TypesComboBox.Text := TypesComboBox.Items[i];
Break;
end
end;
if wpTFbCommonType <> nil then
FldSizeEdit.Visible := (wpTFbCommonType.FbFld.sType = ftString)
else
FldSizeEdit.Visible := False;
end;
RefGroup :
// Выставка в ComboBox индекса ссылочного типа
begin
TypesComboBox.Text := 'Ссылка на таблицу не найдена';
for i:=0 to TypesComboBox.Items.Count-1 do
begin
wpTFbCommonType := pTFbCommonType(TypesComboBox.Items.Objects[i]);
if wpTFbCommonType.FbRef.spTableInfo.sTableAttr.Values['sTableName'] =
FDbInterface.N_pTFieldInfo.sFieldAttr.Values['sMTableName'] then
begin
TypesComboBox.ItemIndex := i;
TypesComboBox.Text := TypesComboBox.Items[i];
Break;
end;
end;
end;
PicGroup :
// Выставка в ComboBox индекса списочного типа
begin
TypesComboBox.Text := 'Ссылка на список не найдена';
for i:=0 to TypesComboBox.Items.Count-1 do
begin
wpTFbCommonType := pTFbCommonType(TypesComboBox.Items.Objects[i]);
if wpTFbCommonType.FbPic.sDescr =
FDbInterface.N_pTFieldInfo.sFieldAttr.Values['sPicDescr'] then
begin
TypesComboBox.ItemIndex := i;
TypesComboBox.Text := TypesComboBox.Items[i];
Break;
end;
end;
end;
LUpGroup :
// Выставка в ComboBox индекса следящего типа
begin
TypesComboBox.Text := 'Ссылка на поле не найдена';
for i:=0 to TypesComboBox.Items.Count-1 do
begin
wpTFbCommonType := pTFbCommonType(TypesComboBox.Items.Objects[i]);
wpTTableInfo := wpTFbCommonType.FbLUp.spTableInfo;
if wpTTableInfo = nil then
Continue;
if wpTTableInfo.sTableAttr.Values['sTableName'] <>
FDbInterface.N_pTFieldInfo.sFieldAttr.Values['sMTableName'] then
Continue;
wspTFieldInfo := wpTFbCommonType.FbLUp.spFieldInfo;
if wspTFieldInfo.sFieldAttr.Values['sFieldName'] <>
FDbInterface.N_pTFieldInfo.sFieldAttr.Values['sMFieldName'] then
Continue;
TypesComboBox.ItemIndex := i;
TypesComboBox.Text := TypesComboBox.Items[i];
Break;
end;
end;
NoGroup :
begin
end;
end;
end;
Procedure TFldDlgFr.OkBtnClick(Sender: TObject);
Var
k : Integer;
wErrorStr : String;
begin
if not AllCharsLatinic(FldNameEdit.Text) then
begin
Application.MessageBox('Допускаются только латинские буквы',
' Ошибка в идентификаторе поля', MB_OK);
FldNameEdit.SetFocus;
Exit;
end;
k := TypeGroupCmBox.ItemIndex;
if k < 0 then
begin
FbKernelWarning('Не выбрана группа данных');
Exit;
end;
FTFbTypeGroup := TFbTypeGroup(TypeGroupCmBox.Items.Objects[k]);
// Выбор ссылки на объект FpTFbCommonType
FpTFbCommonType := Get_SelectedFbFldTypeN(FDbInterface, TypesComboBox.ItemIndex,
TypesComboBox.Items, FTFbTypeGroup, True);
{ Общий контроль }
wErrorStr := '';
if TrimF(FldNameEdit.Text) = '' then
begin
if wErrorStr = '' then
wErrorStr := 'Не задан идентификатор поля'
else
wErrorStr := wErrorStr + #13'Не задан идентификатор поля';
FldNameEdit.SetFocus;
end;
if TrimF(FldCaptionEdit.Text) = '' then
begin
if wErrorStr = '' then
wErrorStr := 'Не задано наименование поля'
else
wErrorStr := wErrorStr + #13'Не задано наименование поля';
FldCaptionEdit.SetFocus;
end;
if TrimF(FldDescrEdit.Text) = '' then
begin
if wErrorStr = '' then
wErrorStr := 'Не задано описание поля'
else
wErrorStr := wErrorStr + #13'Не задано описание поля';
FldDescrEdit.SetFocus;
end;
if FpTFbCommonType = nil then
begin
if wErrorStr = '' then
wErrorStr := 'Не задан тип данных'
else
wErrorStr := wErrorStr + #13'Не задан тип данных';
TypesComboBox.SetFocus;
end;
{ Предварительная детализация поля }
FTFieldType := ftUnknown;
case FpTFbCommonType.FbTypeGroup of
FldGroup :
begin
FTFieldType := FpTFbCommonType.FbFld.sType;
end;
RefGroup :
begin
FTFieldType := ftInteger;
end;
PicGroup :
begin
FTFieldType := FpTFbCommonType.FbPic.sType;
end;
LUpGroup :
begin
FTFieldType := FpTFbCommonType.FbLUp.sType;
end;
end;
FModalRes := FTFieldType <> ftUnknown;
if not FModalRes then
begin
FbKernelWarning('Не выбран тип поля!');
TypesComboBox.SetFocus;
Exit;
end;
Close;
end;
Function TFldDlgFr.Execute: Bool;
begin
Result := False;
if not FModalRes then
Exit;
try
// Указатель на выбранный тип уже должен быть задан
if FpTFbCommonType = nil then
Exit;
// Результаты передаются в форму TbDefFr
FDbInterface.N_pTFieldInfo.sFieldAttr.Values['sFieldCaption'] := FldCaptionEdit.Text;
FDbInterface.N_pTFieldInfo.sFieldAttr.Values['sFieldDescr'] := FldDescrEdit.Text;
case FpTFbCommonType.FbTypeGroup of
FldGroup :
begin // базовый тип данных
FDbInterface.N_pTFieldInfo.sFieldAttr.Values['sFieldName'] := FldNameEdit.Text;
FDbInterface.N_pTFieldInfo.sFieldAttr.Values['sMTableName'] := '';
FDbInterface.N_pTFieldInfo.sFieldAttr.Values['sMFieldName'] := '';
FDbInterface.N_pTFieldInfo.sFieldAttr.Values['sPicDescr'] := '';
FDbInterface.N_pTFieldInfo.sFieldAttr.Values['sAgregateExpr']:= '';
FDbInterface.N_pTFieldInfo.sMTTableInfo := nil;
FDbInterface.N_pTFieldInfo.sMTFieldInfo := nil;
FDbInterface.N_pTFieldInfo.sPickList := nil;
FDbInterface.N_pTFieldInfo.sFieldType := FpTFbCommonType.FbFld.sType;
if FldSizeEdit.Visible then
begin
FDbInterface.N_pTFieldInfo.sFieldSize := StrToInt(FldSizeEdit.Text);
FDbInterface.N_pTFieldInfo.sFieldMBytes :=
FDbInterface.N_pTFieldInfo.sFieldSize + 1;
end
else
begin
FDbInterface.N_pTFieldInfo.sFieldSize := FpTFbCommonType.FbFld.sSize;
FDbInterface.N_pTFieldInfo.sFieldMBytes := FpTFbCommonType.FbFld.sBytes;
end;
end;
RefGroup :
begin // ссылка на таблицу
FDbInterface.N_pTFieldInfo.sFieldAttr.Values['sFieldName'] := FldNameEdit.Text;
FDbInterface.N_pTFieldInfo.sFieldAttr.Values['sMTableName'] :=
FpTFbCommonType.FbRef.spTableInfo.sTableAttr.Values['sTableName'];
FDbInterface.N_pTFieldInfo.sFieldAttr.Values['sMFieldName'] := '';
FDbInterface.N_pTFieldInfo.sFieldAttr.Values['sPicDescr'] := '';
FDbInterface.N_pTFieldInfo.sFieldAttr.Values['sAgregateExpr']:= '';
FDbInterface.N_pTFieldInfo.sMTTableInfo := FpTFbCommonType.FbRef.spTableInfo;
FDbInterface.N_pTFieldInfo.sMTFieldInfo := nil;
FDbInterface.N_pTFieldInfo.sPickList := nil;
FDbInterface.N_pTFieldInfo.sFieldType := FpTFbCommonType.FbFld.sType;
FDbInterface.N_pTFieldInfo.sFieldSize := FpTFbCommonType.FbFld.sSize;
FDbInterface.N_pTFieldInfo.sFieldMBytes := FpTFbCommonType.FbFld.sBytes;
end;
PicGroup :
begin // списочный тип данных
FDbInterface.N_pTFieldInfo.sFieldAttr.Values['sFieldName'] := FldNameEdit.Text;
FDbInterface.N_pTFieldInfo.sFieldAttr.Values['sMTableName'] := '';
FDbInterface.N_pTFieldInfo.sFieldAttr.Values['sMFieldName'] := '';
FDbInterface.N_pTFieldInfo.sFieldAttr.Values['sPicDescr'] :=
FpTFbCommonType.FbPic.sDescr;
FDbInterface.N_pTFieldInfo.sFieldAttr.Values['sAgregateExpr']:= '';
FDbInterface.N_pTFieldInfo.sMTTableInfo := nil;
FDbInterface.N_pTFieldInfo.sMTFieldInfo := nil;
FDbInterface.N_pTFieldInfo.sPickList := FpTFbCommonType.FbPic.sPickList;
FDbInterface.N_pTFieldInfo.sFieldType := FpTFbCommonType.FbFld.sType;
FDbInterface.N_pTFieldInfo.sFieldSize := FpTFbCommonType.FbPic.sSize;
FDbInterface.N_pTFieldInfo.sFieldMBytes := FpTFbCommonType.FbPic.sBytes;
end;
LUpGroup :
begin // следящий тип данных
FDbInterface.N_pTFieldInfo.sFieldAttr.Values['sFieldName'] := FldNameEdit.Text;
FDbInterface.N_pTFieldInfo.sFieldAttr.Values['sMTableName'] :=
FpTFbCommonType.FbLUp.spTableInfo.sTableAttr.Values['sTableName'];
FDbInterface.N_pTFieldInfo.sFieldAttr.Values['sMFieldName'] :=
FpTFbCommonType.FbLUp.spFieldInfo.sFieldAttr.Values['sFieldName'];
FDbInterface.N_pTFieldInfo.sFieldAttr.Values['sPicDescr'] := '';
FDbInterface.N_pTFieldInfo.sFieldAttr.Values['sAgregateExpr']:= '';
FDbInterface.N_pTFieldInfo.sMTTableInfo := FpTFbCommonType.FbLUp.spTableInfo;
FDbInterface.N_pTFieldInfo.sMTFieldInfo := FpTFbCommonType.FbLUp.spFieldInfo;
FDbInterface.N_pTFieldInfo.sPickList := nil;
FDbInterface.N_pTFieldInfo.sFieldType := FpTFbCommonType.FbLUp.sType;
// Размер поля берется из структуры поля, на которое берется ссылка
FDbInterface.N_pTFieldInfo.sFieldSize :=
FpTFbCommonType.FbLUp.spFieldInfo.sFieldSize;
FDbInterface.N_pTFieldInfo.sFieldMBytes :=
FpTFbCommonType.FbLUp.spFieldInfo.sFieldMBytes;
end;
end;
except
end;
Result := True;
end;
Procedure TFldDlgFr.FldNameEditKeyUp(Sender: TObject; Var Key: Word;
Shift: TShiftState);
begin
if Key = VK_UP then
Self.FindNextControl(Sender as TWinControl, False, True, True).SetFocus
else if Key = VK_DOWN then
Self.FindNextControl(Sender as TWinControl, True, True, True).SetFocus;
end;
procedure TFldDlgFr.TypeGroupCmBoxChange(Sender: TObject);
Var
k : Integer;
wTFbTypeGroup : TFbTypeGroup;
begin
k := TypeGroupCmBox.ItemIndex;
if k < 0 then
Exit;
FldNameEdit.Enabled := True;
FldNameEdit.Color := clWhite;
wTFbTypeGroup := TFbTypeGroup(TypeGroupCmBox.Items.Objects[k]);
// Заполнить универсальный список списком выбранного комб. типа
UpdateFieldTypesN(FDbInterface, TypesComboBox, wTFbTypeGroup);
SetTypeGroupLayout(wTFbTypeGroup);
if wTFbTypeGroup = RefGroup then
begin
FldNameEdit.Enabled := False;
FldNameEdit.Color := clSilver;
end;
// Установим фокус ввода на TypesComboBox
TypesComboBox.SetFocus;
end;
Procedure TFldDlgFr.SetTypeGroupLayout(ffTFbTypeGroup : TFbTypeGroup);
begin
// Типовой вид, который будем уточнять
TypesComboBox.Width := 354;
TypesComboBox.BringToFront;
TypesComboBox.Enabled := True;
case ffTFbTypeGroup of
FldGroup :
begin { базовая группа данных }
TypesComboBox.Width := 262;
end;
RefGroup : ;
PicGroup : ;
LUpGroup : ;
NoGroup :
begin
TypesComboBox.Enabled := False;
TypesComboBox.Color := clSilver;
end;
end;
end;
procedure TFldDlgFr.TypesComboBoxKeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then
Self.FindNextControl( Sender as TWinControl, True, True, True).SetFocus;
end;
procedure TFldDlgFr.TypesComboBoxClick(Sender: TObject);
Var
k : Integer;
wpTFbCommonType : pTFbCommonType;
wpTTableInfo : pTTableInfo;
wpTFieldInfo : pTFieldInfo;
wFieldName,
wFieldDescr : String;
wCaptionUnique : Boolean;
begin { Отслеживание типов данных при выборе из списка }
k := TypesComboBox.ItemIndex;
wpTFbCommonType := pTFbCommonType(TypesComboBox.Items.Objects[k]);
FldNameEdit.Enabled := True;
case wpTFbCommonType.FbTypeGroup of
FldGroup :
begin
FldSizeEdit.Visible := wpTFbCommonType.FbFld.sType = ftString;
Label5.Visible := FldSizeEdit.Visible;
if FldSizeEdit.Visible then
FldSizeEdit.SetFocus;
end;
RefGroup :
begin
FldNameEdit.Enabled := False;
FldNameEdit.Color := clSilver;
wpTTableInfo := wpTFbCommonType.FbRef.spTableInfo;
if CreateRefFieldName(FDbInterface, wpTFbCommonType, wFieldName) then
begin
FldNameEdit.Text := wFieldName;
FldCaptionEdit.Text := wpTTableInfo.sTableAttr.Values['sTableCaption'];
FldDescrEdit.Text := 'Ссылка на таблицу: ' +
wpTTableInfo.sTableAttr.Values['sTableCaption'];
end;
end;
PicGroup :
begin
FldNameEdit.Text := FDbInterface.Get_UniqueFieldName(
FDbInterface.Current_pTTableInfo, nil, wCaptionUnique, wFieldDescr);
FldCaptionEdit.Text := wpTFbCommonType.FbPic.sDescr;
FldDescrEdit.Text := 'Значение из списка: ' +
wpTFbCommonType.FbPic.sDescr;
FldSizeEdit.Text := IntToStr(wpTFbCommonType.FbPic.sSize);
end;
LUpGroup :
begin
FldNameEdit.Enabled := False;
FldNameEdit.Color := clSilver;
wpTTableInfo := wpTFbCommonType.FbLUp.spTableInfo;
wpTFieldInfo := wpTFbCommonType.FbLUp.spFieldInfo;
wFieldName := Get_FbQueryFieldName(wpTTableInfo, wpTFieldInfo);
FldNameEdit.Text := wFieldName;
FldCaptionEdit.Text := Get_FbFullFieldNameS(
wpTTableInfo.sTableAttr.Values['sTableCaption'],
wpTFieldInfo.sFieldAttr.Values['sFieldCaption']);
FldDescrEdit.Text := 'Отлеживание поля: ' +
Get_FbFullFieldNameS(wpTTableInfo.sTableAttr.Values['sTableCaption'],
wpTFieldInfo.sFieldAttr.Values['sFieldCaption']);
end;
NoGroup : ;
end;
end;
procedure TFldDlgFr.FldSizeEditKeyPress(Sender: TObject; var Key: Char);
begin
if not(Key in ['0', '1', '2', '3', '4', '5', '6', '7', '8', '9']) then
Key := #0;
end;
end.
