SmartFactory_NEOL/SOURCE/Agent,Kiosk/Lib/base_20251105_old/GeometryMst.pas
2026-09-04 14:08:41 +09:00

282 lines
8.7 KiB
ObjectPascal
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

unit GeometryMst;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
wItem,
FireDAC.Stan.Intf,
FireDAC.Stan.Option, FireDAC.Stan.Error, FireDAC.UI.Intf, FireDAC.Phys.Intf,
FireDAC.Stan.Def, FireDAC.Stan.Pool, FireDAC.Stan.Async, FireDAC.Phys,
FireDAC.Stan.Param, FireDAC.DatS, FireDAC.DApt.Intf, FireDAC.DApt,
FireDAC.Phys.PGDef, FireDAC.VCLUI.Wait, FireDAC.Comp.UI, FireDAC.Phys.PG,
Data.DB, FireDAC.Comp.DataSet, FireDAC.Comp.Client
;
type
TGeometryMst = class(TwItem)
private
{ Private declarations }
FDescriptions: string;
FqPartList: TList;
protected
{ Protected declarations }
public
{ Public declarations }
constructor Create(AOwner: TObject);// override;
destructor Destroy; override;
class function xAddSqlMark(velStr: string): string;
class function xGetStrsGeometryMstName(AQuery: TFDQuery): TStrings;
class function LoadFromStringsQuery(AQuery: TFDQuery): TStrings;
class function xGetObjsGeometryMstToPartItemList(AQuery: TFDQuery; name: string): TList;
class function LoadFromQueryGeoList(AQuery: TFDQuery): TList;
function xGetRelsGeometryPartItemR(AQuery: TFDQuery): TList;
function LoadFromQueryRelList(AQuery: TFDQuery): TList;
procedure xFreeAllFqPartList;
property qPartList: TList read FqPartList write FqPartList;
published
{ Published declarations }
property Descriptions: string read FDescriptions write FDescriptions;
end;
implementation
uses
PartItemMst, GeometryPartItemR;
{ TGeometryMst }
constructor TGeometryMst.Create(AOwner: TObject);
begin
FqPartList := TList.Create;
end;
destructor TGeometryMst.Destroy;
var
i: Integer;
tmpObj: TObject;
begin
if FqPartList <> nil then begin
i := 0;
while i < FqPartList.Count do begin
tmpObj := FqPartList.Items[i];
if tmpObj <> nil then tmpObj.Free;
tmpObj := nil;
FqPartList.Delete(i);
end;
FqPartList.Free; FqPartList:=nil;
end;
inherited;
end;
class function TGeometryMst.LoadFromQueryGeoList(AQuery: TFDQuery): TList;
var
i, idx, nidx, nnidx: Integer;
valName, fieName, obidVal: string;
curGeo, tmpGeo: TGeometryMst;
curPart: TPartItemMst;
begin
Result := TList.Create;
AQuery.First;
//<2F>ߺ<EFBFBD> <20>÷<EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> ã<><C3A3>..
nidx := -1;
for i := 0 to AQuery.FieldCount-1 do begin
fieName := AQuery.Fields[i].FieldName;
if Pos('_1',fieName) > 0 then begin
nidx := i;
Break;
end;
end;
AQuery.First;
while not AQuery.Eof do begin
obidVal := AQuery.FieldByName('OBID').AsString;
//<2F>ߺ<EFBFBD> <20><>ü ã<><C3A3>..
idx := -1;
for i := 0 to Result.Count - 1 do begin
curGeo := TGeometryMst(Result[i]);
if SameText(obidVal, curGeo.OBID) then begin
idx := i;
Break;
end;
end;
if idx = -1 then begin
curGeo := TGeometryMst.Create(nil);
for i := 0 to nidx-1 do begin
fieName := AQuery.Fields[i].FieldName;
valName := AQuery.Fields[i].AsString;
if SameText(fieName, 'OBID') then curGeo.OBID := valName
else if SameText(fieName, 'Name') then curGeo.Name := valName
else if SameText(fieName, 'wClassName') then curGeo.wClassName := valName
else if SameText(fieName, 'CreateDate') then curGeo.CreateDate := valName
else if SameText(fieName, 'CreateTime') then curGeo.CreateTime := valName
else if SameText(fieName, 'CreatorID') then curGeo.CreatorID := valName
else if SameText(fieName, 'IsValid') then curGeo.IsValid := valName
else if SameText(fieName, 'LcStatus') then curGeo.LcStatus := valName
else if SameText(fieName, 'Descriptions') then curGeo.Descriptions := valName;
end;
Result.Add(curGeo);
end else begin
curGeo := TGeometryMst(Result.Items[idx]);
end;
curPart := TPartItemMst.Create(nil);
for i := nidx to AQuery.FieldCount-1 do begin
fieName := StringReplace(AQuery.Fields[i].FieldName, '_1', '', [rfReplaceAll]);
valName := AQuery.Fields[i].AsString;
if SameText(fieName, 'OBID') then curPart.OBID := valName
else if SameText(fieName, 'Name') then curPart.Name := valName
else if SameText(fieName, 'wClassName') then curPart.wClassName := valName
else if SameText(fieName, 'CreateDate') then curPart.CreateDate := valName
else if SameText(fieName, 'CreateTime') then curPart.CreateTime := valName
else if SameText(fieName, 'CreatorID') then curPart.CreatorID := valName
else if SameText(fieName, 'IsValid') then curPart.IsValid := valName
else if SameText(fieName, 'LcStatus') then curPart.LcStatus := valName
else if SameText(fieName, 'Kind') then curPart.Kind := valName
else if SameText(fieName, 'Descriptions') then curPart.Descriptions := valName;
end;
curGeo.qPartList.Add(curPart);
AQuery.Next;
end;
end;
function TGeometryMst.LoadFromQueryRelList(AQuery: TFDQuery): TList;
var
curRel: TGeometryPartItemR;
begin
Result := TList.Create;
while not AQuery.Eof do begin
curRel := TGeometryPartItemR.Create(nil);
curRel.Name := AQuery.FieldByName('Name').AsString;
curRel.OBID := AQuery.FieldByName('OBID').AsString;
curRel.wClassName := AQuery.FieldByName('wClassName').AsString;
curRel.CreateDate := AQuery.FieldByName('CreateDate').AsString;
curRel.CreateTime := FormatDateTime('hh:nn:ss', AQuery.FieldByName('CreateTime').AsDateTime);
curRel.CreatorID := AQuery.FieldByName('CreatorID').AsString;
curRel.IsValid := AQuery.FieldByName('IsValid').AsString;
curRel.Revision := AQuery.FieldByName('Revision').AsString;
curRel.LOBID := AQuery.FieldByName('LOBID').AsString;
curRel.ROBID := AQuery.FieldByName('ROBID').AsString;
curRel.LClassName := AQuery.FieldByName('LClassName').AsString;
curRel.RClassName := AQuery.FieldByName('RClassName').AsString;
curRel.OrdNum := AQuery.FieldByName('OrdNum').AsString;
Result.Add(curRel);
AQuery.Next;
end;
end;
class function TGeometryMst.LoadFromStringsQuery(AQuery: TFDQuery): TStrings;
var
kindVal: string;
begin
Result := TStringList.Create;
while not AQuery.Eof do begin
kindVal := AQuery.FieldByName('Name').AsString;
Result.Add(kindVal);
AQuery.Next;
end;
end;
class function TGeometryMst.xAddSqlMark(velStr: string): string;
begin
Result := '';
Result := '''' + velStr + '''';
end;
procedure TGeometryMst.xFreeAllFqPartList;
var
i: Integer;
tmpObj: TObject;
begin
if FqPartList <> nil then begin
i := 0;
while i < FqPartList.Count do begin
tmpObj := FqPartList.Items[i];
if tmpObj <> nil then tmpObj.Free;
tmpObj := nil;
FqPartList.Delete(i);
end;
FqPartList.Free; FqPartList:=nil;
end;
end;
class function TGeometryMst.xGetObjsGeometryMstToPartItemList(AQuery: TFDQuery;
name: string): TList;
var
sql: string;
begin
Result := nil;
sql := 'SELECT obj0.*, obj2.* FROM "GeometryMst"obj0, "GeometryPartItemR"obj1, "PartItemMst"obj2';
sql := sql + ' WHERE obj0."IsValid"=' + xAddSqlMark('t');
if Length(name) > 0 then sql := sql + ' AND obj0."Name"=' + xAddSqlMark(name);
sql := sql + ' AND obj1."IsValid"=' + xAddSqlMark('t');
sql := sql + ' AND obj1."LOBID"= obj0."OBID"';
sql := sql + ' AND obj2."IsValid"=' + xAddSqlMark('t');
sql := sql + ' AND obj2."OBID"=obj1."ROBID"';
sql := sql + ' ORDER BY obj1."OrdNum"';
try
AQuery.Close;
AQuery.SQL.Text := sql;
AQuery.Open;
except
on E: Exception do ShowMessage('xGetObjsGeometryMstToPartItemList <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>: ' + E.Message);
end;
Result := LoadFromQueryGeoList(AQuery);
end;
function TGeometryMst.xGetRelsGeometryPartItemR(AQuery: TFDQuery): TList;
var
sql: string;
begin
Result := nil;
sql := 'SELECT obj1.* FROM "GeometryMst"obj0, "GeometryPartItemR"obj1, "PartItemMst"obj2';
sql := sql + ' WHERE obj0."IsValid"=' + xAddSqlMark('t');
sql := sql + ' AND obj0."OBID"=' + xAddSqlMark(OBID);
sql := sql + ' AND obj1."IsValid"=' + xAddSqlMark('t');
sql := sql + ' AND obj1."LOBID"= obj0."OBID"';
sql := sql + ' AND obj2."IsValid"=' + xAddSqlMark('t');
sql := sql + ' AND obj2."OBID"=obj1."ROBID"';
sql := sql + ' ORDER BY obj1."OrdNum"';
try
AQuery.Close;
AQuery.SQL.Text := sql;
AQuery.Open;
except
on E: Exception do ShowMessage('xGetRelsGeometryPartItemR <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>: ' + E.Message);
end;
Result := LoadFromQueryRelList(AQuery);
end;
class function TGeometryMst.xGetStrsGeometryMstName(AQuery: TFDQuery): TStrings;
var
sql: string;
begin
Result := nil;
sql := 'SELECT DISTINCT obj0."Name" FROM "GeometryMst"obj0';
sql := sql + ' WHERE obj0."IsValid"=' + xAddSqlMark('t');
try
AQuery.Close;
AQuery.SQL.Text := sql;
AQuery.Open;
except
on E: Exception do ShowMessage('xGetUniqStrsPartItemKind <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>: ' + E.Message);
end;
Result := LoadFromStringsQuery(AQuery);
end;
end.