mirror of
http://gitlab.expertsoft.com.ua/git/expertcad
synced 2026-01-11 17:25:39 +02:00
409 lines
15 KiB
ObjectPascal
409 lines
15 KiB
ObjectPascal
unit U_ImportDBF;
|
||
|
||
interface
|
||
|
||
uses
|
||
Windows, U_LNG, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
|
||
Dialogs, StdCtrls, Mask, RzEdit, DB, DBTables, RzButton,
|
||
|
||
ComCtrls,
|
||
U_SCSComponent, U_Main, U_BaseCommon, U_BaseConstants, IB_Services, siComp, siLngLnk;
|
||
|
||
const
|
||
|
||
// razdel index
|
||
rlNone = 0;
|
||
rlRoot = 1;
|
||
rlRazdel = 2;
|
||
rlPodrazdel = 3;
|
||
|
||
// FieldNames
|
||
fnARTPROIZV = 'ARTPROIZV';
|
||
fnARTDISTR = 'ARTDISTR';
|
||
fnCOMPTYPE = 'COMPTYPE';
|
||
fnNETTYPE = 'NETTYPE';
|
||
fnPRODUCER = 'PRODUCER';
|
||
fnNAME = 'NAME';
|
||
fnPRICE = 'PRICE';
|
||
fnPRICEOPT = 'PRICEOPT';
|
||
fnRAZDEL = 'RAZDEL';
|
||
fnPODRAZDEL = 'PODRAZDEL';
|
||
|
||
|
||
|
||
type
|
||
TF_ImportDBF = class(TForm)
|
||
Table: TTable;
|
||
Label1: TLabel;
|
||
edFileName: TRzEdit;
|
||
btChoiceDBF: TRzButton;
|
||
OpenDialog: TOpenDialog;
|
||
btGrubCompons: TRzButton;
|
||
btClose: TRzBitBtn;
|
||
lng_Forms: TsiLangLinked;
|
||
cbLoadFromTemplates: TCheckBox;
|
||
procedure btChoiceDBFClick(Sender: TObject);
|
||
procedure btGrubComponsClick(Sender: TObject);
|
||
private
|
||
FNBNode: TTreeNode;
|
||
FGrubClickCount: Integer;
|
||
|
||
function AddCatalog(AParentNode: TTreeNode; ANewCatalogName: String): TSCSCatalog;
|
||
public
|
||
procedure Execute(ANBNode: TTreeNode);
|
||
end;
|
||
|
||
var
|
||
F_ImportDBF: TF_ImportDBF;
|
||
|
||
implementation
|
||
Uses U_Animate, U_ProtectionCommon;
|
||
{$R *.dfm}
|
||
|
||
procedure TF_ImportDBF.btChoiceDBFClick(Sender: TObject);
|
||
begin
|
||
if OpenDialog.Execute then
|
||
begin
|
||
edFileName.Text := OpenDialog.FileName;
|
||
end;
|
||
end;
|
||
|
||
function TF_ImportDBF.AddCatalog(AParentNode: TTreeNode; ANewCatalogName: String): TSCSCatalog;
|
||
var
|
||
Node: TTreeNode;
|
||
begin
|
||
Result := nil;
|
||
Node := F_NormBase.MakeDir(cfBase, AParentNode, ANewCatalogName, itDir, nil);
|
||
Result := TSCSCatalog.Create(F_NormBase);
|
||
Result.LoadCatalogByID(PObjectData(Node.Data).ObjectID);
|
||
Result.TreeViewNode := Node;
|
||
end;
|
||
|
||
procedure TF_ImportDBF.btGrubComponsClick(Sender: TObject);
|
||
var
|
||
RootCatalog: TSCSCatalog;
|
||
RootNode: TTreeNode;
|
||
WorkCatalog: TSCSCatalog;
|
||
CatalogNode: TTreeNode;
|
||
SCSCatalog: TSCSCatalog;
|
||
SCSComponent: TSCSComponent;
|
||
|
||
RazdelLevel: Integer;
|
||
NewRazdelLevel: Integer;
|
||
|
||
PriceType: Char;
|
||
strPrice: String;
|
||
|
||
DirName: String;
|
||
CurrIDComponentType: Integer;
|
||
CurrIDNetType: Integer;
|
||
CurrIDProducer: Integer;
|
||
|
||
RecordCount: Integer;
|
||
RecNo: Integer;
|
||
|
||
SuppliesKind: TSuppliesKind;
|
||
ptrSuppliesKind: PSuppliesKind;
|
||
|
||
ComponentTemplates: TSCSComponents;
|
||
ComponentTemplate: TSCSComponent;
|
||
ComponDataFlags: TCompDataFlags;
|
||
LastNppPort: Integer;
|
||
StepIndex: Integer;
|
||
|
||
AllSuppliesKinds: TList;
|
||
Stream: TMemoryStream;
|
||
StreamSize: Integer;
|
||
begin
|
||
try
|
||
if FileExists(edFileName.Text) then
|
||
begin
|
||
Table.Active := false;
|
||
Table.DatabaseName := ExtractFileDir(edFileName.Text);
|
||
Table.TableName := ExtractFileName(edFileName.Text);
|
||
Table.Active := true;
|
||
if Table.Active then
|
||
begin
|
||
RazdelLevel := rlRoot;
|
||
WorkCatalog := nil;
|
||
|
||
ComponDataFlags := [cdCableCanalConnectors,
|
||
//cdConections,
|
||
cdCrossConnections,
|
||
cdProperties,
|
||
cdInterfaces,
|
||
cdComponentType,
|
||
cdNorms,
|
||
cdResources];
|
||
|
||
ComponentTemplates := TSCSComponents.Create(true);
|
||
AllSuppliesKinds := nil;
|
||
|
||
//RootNode := F_NormBase.MakeDir(cfBase, FNBNode, Table.TableName, itDir, nil);
|
||
//RootCatalog := TSCSCatalog.Create(F_NormBase);
|
||
//RootCatalog.LoadCatalogByID(PObjectData(RootNode.Data).ObjectID);
|
||
//RootCatalog.TreeViewNode := RootNode;
|
||
//WorkCatalog := RootCatalog;
|
||
WorkCatalog := AddCatalog(FNBNode, Table.TableName);
|
||
CurrIDComponentType := 0; //31; // Null
|
||
CurrIDNetType := 0;
|
||
CurrIDProducer := 0;
|
||
|
||
RecordCount := Table.RecordCount;
|
||
RecNo := 0;
|
||
Stream := TMemoryStream.Create;
|
||
F_NormBase.F_Animate.GMaxProgressPos := RecordCount;
|
||
F_NormBase.F_Animate.StartAnimate(cImportDBF_Msg1, aviCopyFiles, aiProgressBar);
|
||
try
|
||
Table.First;
|
||
while Not Table.Eof do
|
||
begin
|
||
Inc(RecNo);
|
||
|
||
//*** <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD>
|
||
if (Table.FieldDefs.IndexOf(fnCOMPTYPE) <> -1) and (Table.FieldByName(fnCOMPTYPE).AsString <> '') then
|
||
CurrIDComponentType := StrToInt(Table.FieldByName(fnCOMPTYPE).AsString);
|
||
if (Table.FieldDefs.IndexOf(fnNETTYPE) <> -1) and (Table.FieldByName(fnNETTYPE).AsString <> '') then
|
||
CurrIDNetType := StrToInt(Table.FieldByName(fnNETTYPE).AsString);
|
||
if (Table.FieldDefs.IndexOf(fnPRODUCER) <> -1) and (Table.FieldByName(fnPRODUCER).AsString <> '') then
|
||
CurrIDProducer := StrToInt(Table.FieldByName(fnPRODUCER).AsString);
|
||
|
||
//*** <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>
|
||
if (Table.FieldByName(fnRAZDEL).AsString <> '') or
|
||
(Table.FieldByName(fnPODRAZDEL).AsString <> '') then
|
||
begin
|
||
NewRazdelLevel := rlNone;
|
||
DirName := '';
|
||
|
||
//*** <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>
|
||
if Table.FieldByName(fnRAZDEL).AsString <> '' then
|
||
begin
|
||
// <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>, <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> Root
|
||
if RazdelLevel = rlRazdel then
|
||
WorkCatalog := TSCSCatalog(WorkCatalog.Parent)
|
||
else // <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>, <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> Root
|
||
if RazdelLevel = rlPodRazdel then
|
||
WorkCatalog := TSCSCatalog(WorkCatalog.Parent.Parent);
|
||
NewRazdelLevel := rlRazdel;
|
||
DirName := Table.FieldByName(fnRAZDEL).AsString;
|
||
end
|
||
else
|
||
if Table.FieldByName(fnPODRAZDEL).AsString <> '' then
|
||
begin
|
||
NewRazdelLevel := rlPodRazdel;
|
||
if RazdelLevel = rlRazdel then
|
||
NewRazdelLevel := rlPodRazdel
|
||
else
|
||
if RazdelLevel = rlPodRazdel then
|
||
WorkCatalog := TSCSCatalog(WorkCatalog.Parent)
|
||
else
|
||
//*** <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>-<2D><><EFBFBD><EFBFBD>
|
||
if RazdelLevel = rlRoot then
|
||
NewRazdelLevel := rlRazdel;
|
||
DirName := Table.FieldByName(fnPODRAZDEL).AsString;
|
||
end;
|
||
|
||
if NewRazdelLevel <> rlNone then
|
||
begin
|
||
SCSCatalog := AddCatalog(WorkCatalog.TreeViewNode, DirName);
|
||
WorkCatalog.AddChildCatalogToList(SCSCatalog);
|
||
WorkCatalog := SCSCatalog;
|
||
|
||
RazdelLevel := NewRazdelLevel;
|
||
end;
|
||
|
||
//*** <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD>
|
||
//if (Table.FieldDefs.IndexOf(fnIzm) <> -1) and (Table.FieldByName(fnCOMPTYPE).AsString <> '') then
|
||
// CurrIDComponentType := StrToInt(Table.FieldByName(fnCOMPTYPE).AsString);
|
||
end
|
||
else //*** <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||
if (WorkCatalog <> nil) and (Table.FieldByName(fnName).AsString <> '') then
|
||
begin
|
||
//*** <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||
ZeroMemory(@SuppliesKind, SizeOf(TSuppliesKind));
|
||
try
|
||
if Table.FieldDefs.IndexOf(fnIzm) <> -1 then
|
||
SuppliesKind.Izm := Table.FieldByName(fnIzm).AsString;
|
||
if Table.FieldDefs.IndexOf(fnUnitKolvo) <> -1 then
|
||
if Table.FieldByName(fnUnitKolvo).AsString <> '' then
|
||
SuppliesKind.UnitKolvo := StrToFloatU(CorrectStrToFloat(Table.FieldByName(fnUnitKolvo).AsString));
|
||
except
|
||
on E: Exception do AddExceptionToLogEx('TF_ImportDBF.btGrubComponsClick', E.Message);
|
||
end;
|
||
ptrSuppliesKind := nil;
|
||
if SuppliesKind.UnitKolvo > 0 then
|
||
begin
|
||
if AllSuppliesKinds = nil then
|
||
AllSuppliesKinds := F_NormBase.DM.GetAllSuppliesKinds;
|
||
ptrSuppliesKind := GetSuppliesKindByIzmAndKolvo('', SuppliesKind.Izm, SuppliesKind.UnitKolvo, AllSuppliesKinds);
|
||
//*** <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>, <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><>
|
||
if ptrSuppliesKind = nil then
|
||
begin
|
||
GetZeroMem(ptrSuppliesKind, SizeOf(TSuppliesKind));
|
||
ptrSuppliesKind.Izm := SuppliesKind.Izm;
|
||
ptrSuppliesKind.UnitKolvo := SuppliesKind.UnitKolvo;
|
||
ptrSuppliesKind.Name := CPacking+' ' +FloatToStr(RoundCP(ptrSuppliesKind.UnitKolvo))+' '+SuppliesKind.Izm;
|
||
ptrSuppliesKind.NameTradUOM := ptrSuppliesKind.Name;
|
||
ptrSuppliesKind.Izm := ptrSuppliesKind.IzmTradUOM;
|
||
ptrSuppliesKind.UnitKolvo := ptrSuppliesKind.UnitKolvoTradUOM;
|
||
F_NormBase.DM.InsertSuppliesKindToTopDirType(ptrSuppliesKind); //F_NormBase.DM.SaveSuppliesKind(meMake, ptrSuppliesKind);
|
||
//ptrSuppliesKind.ID := GenIDFromTable(F_NormBase.DM.Query_Select, gnSuppliesKindsID, 0);
|
||
|
||
AllSuppliesKinds.Add(ptrSuppliesKind);
|
||
end;
|
||
if ptrSuppliesKind <> nil then
|
||
SuppliesKind := ptrSuppliesKind^;
|
||
end;
|
||
|
||
|
||
SCSComponent := TSCSComponent.Create(F_NormBase);
|
||
SCSComponent.ID_ComponentType := CurrIDComponentType;
|
||
SCSComponent.IDNetType := CurrIDNetType;
|
||
SCSComponent.ID_Producer := CurrIDProducer;
|
||
SCSComponent.LoadComponentType;
|
||
|
||
if cbLoadFromTemplates.Checked and (SCSComponent.ComponentType.IDComponTemplate > 0) then
|
||
begin
|
||
ComponentTemplate := ComponentTemplates.GetComponenByID(SCSComponent.ComponentType.IDComponTemplate);
|
||
if ComponentTemplate = nil then
|
||
begin
|
||
ComponentTemplate := TSCSComponent.Create(F_NormBase);
|
||
ComponentTemplates.Add(ComponentTemplate);
|
||
|
||
ComponentTemplate.LoadComponentByID(SCSComponent.ComponentType.IDComponTemplate);
|
||
ComponentTemplate.LoadComponentData(ComponDataFlags);
|
||
end;
|
||
if ComponentTemplate <> nil then
|
||
begin
|
||
SCSComponent.Assign(ComponentTemplate, true, true);
|
||
LastNppPort := 0;
|
||
StepIndex := 0;
|
||
SCSComponent.DefineIDsBeforeSaveAsNew{(nil, nil, LastNppPort, StepIndex)};
|
||
end;
|
||
end
|
||
else
|
||
begin
|
||
SCSComponent.LoadPropertyesFromComponentType;
|
||
if SCSComponent.ComponentType.IDDesignIcon <> 0 then
|
||
SCSComponent.IDObjectIcon := SCSComponent.ComponentType.IDDesignIcon;
|
||
end;
|
||
|
||
|
||
SCSComponent.Cypher := F_NormBase.DM.GenComponentNewCypher; //GenNewComponentCypher;
|
||
SCSComponent.Name := Table.FieldByName(fnName).AsString;
|
||
if Table.FieldDefs.IndexOf(fnARTDISTR) <> -1 then
|
||
SCSComponent.ArticulDistributor := Table.FieldByName(fnARTDISTR).AsString;
|
||
if Table.FieldDefs.IndexOf(fnARTPROIZV) <> -1 then
|
||
SCSComponent.ArticulProducer := Table.FieldByName(fnARTPROIZV).AsString;
|
||
if SCSComponent.ArticulProducer = '' then
|
||
SCSComponent.ArticulProducer := SCSComponent.ArticulDistributor;
|
||
if SCSComponent.ArticulDistributor = '' then
|
||
SCSComponent.ArticulDistributor := SCSComponent.ArticulProducer;
|
||
|
||
strPrice := Table.FieldByName(fnPRICE).AsString;
|
||
if strPrice <> '' then
|
||
begin
|
||
try
|
||
if (strPrice[1] <> '<27>') and (strPrice[1] <> '$') then
|
||
PriceType := '$'
|
||
else
|
||
begin
|
||
PriceType := strPrice[1];
|
||
Delete(strPrice, 1, 1);
|
||
end;
|
||
strPrice := CorrectStrToFloat(strPrice);
|
||
SCSComponent.Price := RoundCP(StrToFloatU(strPrice));
|
||
SCSComponent.Price_Calc := RoundCP(SCSComponent.Price);
|
||
except
|
||
end;
|
||
end;
|
||
|
||
SCSComponent.IsLine := SCSComponent.ComponentType.IsLine;
|
||
|
||
//*** <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||
if SuppliesKind.Izm <> '' then
|
||
SCSComponent.Izm := SuppliesKind.Izm;
|
||
if ptrSuppliesKind <> nil then
|
||
begin
|
||
SCSComponent.IDSuppliesKind := ptrSuppliesKind.ID;
|
||
SCSComponent.PriceSupply := RoundCP(SCSComponent.Price * ptrSuppliesKind.UnitKolvo);
|
||
end;
|
||
|
||
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||
if Table.FieldDefs.IndexOf(fnNotice) <> -1 then
|
||
SCSComponent.Notice := Table.FieldByName(fnNotice).AsString;
|
||
|
||
//*** <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||
if Table.FieldDefs.IndexOf(fnDesc) <> -1 then
|
||
begin
|
||
Stream.Clear;
|
||
Stream.Position := 0;
|
||
TBlobField(Table.FieldByName(fnDesc)).SaveToStream(Stream);
|
||
StreamSize := Stream.Size;
|
||
if StreamSize > 0 then
|
||
begin
|
||
CopyStream(SCSComponent.Description, Stream);
|
||
end;
|
||
end;
|
||
|
||
|
||
//SCSComponent.LoadPropertyesFromComponentType;
|
||
//if SCSComponent.ComponentType.IDDesignIcon <> 0 then
|
||
// SCSComponent.IDSymbol := SCSComponent.ComponentType.IDDesignIcon;
|
||
|
||
//*** <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD>
|
||
try
|
||
SCSComponent.GuidNB := CreateGUID;
|
||
SCSComponent.SaveComponentAsNew(true, false);
|
||
F_NormBase.AppendToCatalRel(WorkCatalog.ID, SCSComponent.ID);
|
||
SCSComponent.TreeViewNode := F_NormBase.MakeNodeForNewComponent(WorkCatalog.TreeViewNode, SCSComponent);
|
||
|
||
WorkCatalog.AddComponentToList(SCSComponent);
|
||
except
|
||
end;
|
||
end;
|
||
F_NormBase.F_Animate.SetProgressPos(RecNo + 1);
|
||
Table.Next;
|
||
end;
|
||
finally
|
||
F_NormBase.F_Animate.StopAnimate;
|
||
Table.Active := false;
|
||
|
||
ComponentTemplates.Free;
|
||
if AllSuppliesKinds <> nil then
|
||
FreeList(AllSuppliesKinds);
|
||
|
||
FreeAndNil(Stream);
|
||
end;
|
||
end
|
||
else
|
||
ShowMessage(cImportDBF_Msg2+' '+Table.TableName);
|
||
end
|
||
else
|
||
ShowMessage(cImportDBF_Msg3+' '+edFileName.Text);
|
||
except
|
||
on E: Exception do AddExceptionToLogEx('TF_ImportDBF.btGrubComponsClick', E.Message);
|
||
end;
|
||
end;
|
||
|
||
procedure TF_ImportDBF.Execute(ANBNode: TTreeNode);
|
||
begin
|
||
FNBNode := ANBNode;
|
||
FGrubClickCount := 0;
|
||
{$if Defined(ES_GRAPH_SC)}
|
||
OpenDialog.InitialDir := ExeDir;
|
||
{$else}
|
||
OpenDialog.InitialDir := ExtractFileDir(Application.ExeName);
|
||
{$ifend}
|
||
|
||
ShowModal;
|
||
|
||
if FGrubClickCount > 0 then
|
||
begin
|
||
//*** <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><>
|
||
F_NormBase.GSCSBase.NBSpravochnik.LoadSuppliesKinds;
|
||
end;
|
||
end;
|
||
|
||
end.
|