Новичок
Профиль
Группа: Участник
Сообщений: 10
Регистрация: 17.9.2014
Репутация: нет Всего: нет
|
Цитата(-Сергей- @ 12.4.2017, 20:36) | Есть эксперт с открытым исходным кодом CnPack. Он может показывать связи между компонентами, выстраивать их по всякому. Можно поковыряться в его коде, посмотреть как это реализуется и использовать под свои нужды. |
Огромное человеческое спасибо! Всё получилось Вот код, может кому пригодится: Код | uses Windows, SysUtils, Classes, TypInfo, ToolsAPI, DesignIntf, DesignEditors, Controls, Forms, ...;
type TShowPosEditor = class(TComponentEditor) protected procedure ArrangeComponents(Links: TList = nil); overload; procedure ArrangeComponents(AForm: TCustomForm; AComponent: TComponent = nil; Links: TList = nil); overload; procedure SetComponentPos(Form: TCustomForm; Component: TComponent; X, Y: Integer); public procedure ExecuteVerb(Index: Integer); override; function GetVerb(Index: Integer): string; override; function GetVerbCount: Integer; override; end;
{ TShowPosEditor } const _SEditShowPos = 'Изменить порядок вывода HTML кода'; _SEditArrangePos = 'Реорганизовать компоненты'; _NonVisualSize = 28; _NonVisualCaptionSize = 14; _NonVisualCaptionV = 30; _NonvisualClassNamePattern = 'TContainer';
var vSError: string = 'Error'; vSNonNonVisualNotSupport: string = 'Only VCL Designer Supported.';
type TComponentLinkType = (cltMaster, cltDetail); TComponentAccess = class(TComponent);
function CnOtaGetFileEditorForModule(Module: IOTAModule; Index: Integer): IOTAEditor; begin Result := nil; if not Assigned(Module) then Exit; try Result := Module.GetModuleFileEditor(Index); except Result := nil; end; end;
function CnOtaGetFormEditorFromModule(const Module: IOTAModule): IOTAFormEditor; var I: Integer; Editor: IOTAEditor; FormEditor: IOTAFormEditor; begin if Assigned(Module) then begin for I := 0 to Module.GetModuleFileCount - 1 do begin Editor := CnOtaGetFileEditorForModule(Module, I); if Supports(Editor, IOTAFormEditor, FormEditor) then begin Result := FormEditor; Exit; end; end; end; Result := nil; end;
function QuerySvcs(const Instance: IUnknown; const Intf: TGUID; out Inst): Boolean; begin Result := (Instance <> nil) and Supports(Instance, Intf, Inst); end;
function CnOtaGetCurrentModule: IOTAModule; var iModuleServices: IOTAModuleServices; begin QuerySvcs(BorlandIDEServices, IOTAModuleServices, iModuleServices); if iModuleServices <> nil then begin Result := iModuleServices.CurrentModule; Exit; end; Result := nil; end;
function CnOtaGetCurrentSourceFile: string; var iModule: IOTAModule; iEditor: IOTAEditor; begin iModule := CnOtaGetCurrentModule; if iModule <> nil then begin iEditor := iModule.GetCurrentEditor; if iEditor <> nil then begin Result := iEditor.FileName; if Result <> '' then Exit; end; end; Result := ''; end;
function IsForm(const FileName: string): Boolean; var FileExt: string; begin FileExt := UpperCase(ExtractFileExt(FileName)); Result := (FileExt = '.DFM') or (FileExt = '.XFM'); end;
function CurrentIsForm: Boolean; begin Result := IsForm(CnOtaGetCurrentSourceFile); end;
function IsVCLFormEditor(FormEditor: IOTAFormEditor = nil): Boolean; begin if FormEditor = nil then Result := CurrentIsForm else Result := IsForm(FormEditor.FileName); end;
function CnOtaGetFormDesigner: IDesigner; var FormEditor: IOTAFormEditor; NTAFormEditor: INTAFormEditor; begin FormEditor := CnOtaGetFormEditorFromModule(CnOtaGetCurrentModule);
if (FormEditor = nil) or not IsVCLFormEditor(FormEditor) then begin Result := nil; Exit; end;
QuerySvcs(FormEditor, INTAFormEditor, NTAFormEditor);
if NTAFormEditor <> nil then begin Result := NTAFormEditor.GetFormDesigner; Exit; end;
Result := nil; end;
procedure ErrorDlg(Mess: string; Caption: string); begin if Caption = '' then Caption := vSError; Application.MessageBox(PChar(Mess), PChar(Caption), MB_OK + MB_ICONSTOP); end;
function ObjectIsInheritedFromClass(AObj: TObject; const AClassName: string): Boolean; var AClass: TClass; begin Result := False; AClass := AObj.ClassType; while AClass <> nil do begin if AClass.ClassNameIs(AClassName) then begin Result := True; Exit; end; AClass := AClass.ClassParent; end; end;
procedure TShowPosEditor.ArrangeComponents(AForm: TCustomForm; AComponent: TComponent; Links: TList); const _clt: array [Boolean] of TComponentLinkType = (cltDetail, cltMaster); var FreeLinks: Boolean; AOffset: TPoint; I, n, X, Y: Integer; clt: TComponentLinkType; begin AOffset.X := LongRec(TComponentAccess(AComponent).DesignInfo).Lo; AOffset.Y := LongRec(TComponentAccess(AComponent).DesignInfo).Hi; Inc(AOffset.X, (_NonVisualSize + 1));
X := AOffset.X; Y := AOffset.Y;
clt := _clt[AComponent is TMasterHelperLink];
FreeLinks := (Links = nil); if FreeLinks then begin Links := TList.Create; with TrmCustomHelperLink(AComponent) do for I := 0 to ShowPosList.Count - 1 do Links.Add(ShowPosList[I]); end; try n := 0; for I := 0 to Links.Count - 1 do begin TrmAbstractAncestor(Links[I]).ShowPos := I; if not(TrmAbstractAncestor(Links[I]).Owner is TISRMFormat) then begin case clt of cltMaster: Y := AOffset.Y + (I * (_NonVisualSize + 1)); cltDetail: X := AOffset.X + (I * (_NonVisualSize + 1)); end;
SetComponentPos(AForm, TComponent(Links.Items[I]), X, Y);
if TrmCustomHelperLink(Links[I]) is TDetailHelperLink then ArrangeComponents(AForm, TComponent(Links[I])); Inc(n); end; end; finally if FreeLinks then Links.Free end; end;
procedure TShowPosEditor.ArrangeComponents(Links: TList); var AForm: TCustomForm; FormDesigner: IDesigner; AContainer: TComponent; begin
FormDesigner := CnOtaGetFormDesigner; if FormDesigner = nil then Exit;
AForm := nil; AContainer := FormDesigner.Root;
if (AContainer is TWinControl) or ObjectIsInheritedFromClass(AContainer, 'TWidgetControl') then AForm := TCustomForm(AContainer) else if (AContainer.Owner <> nil) and AContainer.Owner.ClassNameIs('TDataModuleForm') then begin AForm := AContainer.Owner as TCustomForm; end;
if AForm = nil then begin ErrorDlg('Ошибка', vSNonNonVisualNotSupport); Exit; end;
ArrangeComponents(AForm, TrmCustomHelperLink(Component), Links);
FormDesigner.Modified; end;
function HWndIsNonvisualComponent(hWnd: hWnd): Boolean; var AClassName: array [0 .. 256] of Char; begin AClassName[GetClassName(hWnd, @AClassName, SizeOf(AClassName) - 1)] := #0; Result := string(AClassName) = _NonvisualClassNamePattern; end;
procedure TShowPosEditor.SetComponentPos(Form: TCustomForm; Component: TComponent; X, Y: Integer); var P: TSmallPoint; H1, H2: hWnd; Offset: TPoint;
procedure GetComponentContainerHandle(AForm: TCustomForm; L, T: Integer; var H1, H2: hWnd; var Offset: TPoint); var R1, R2: TRect; P: TPoint; ParentHandle: hWnd; AControl: TWinControl; I: Integer; begin ParentHandle := AForm.Handle; AControl := AForm;
if AForm.ClassNameIs('TDataModuleForm') then begin for I := 0 to AForm.ControlCount - 1 do if AForm.Controls[I].ClassNameIs('TComponentContainer') and (AForm.Controls[I] is TWinControl) then begin AControl := AForm.Controls[I] as TWinControl; ParentHandle := AControl.Handle; Break; end; end;
H2 := 0; H1 := GetWindow(ParentHandle, GW_CHILD); H1 := GetWindow(H1, GW_HWNDLAST);
while H1 <> 0 do begin if HWndIsNonvisualComponent(H1) and GetWindowRect(H1, R1) then begin P.X := R1.Left; P.Y := R1.Top; P := AControl.ScreenToClient(P);
if (P.X = L) and (P.Y = T) and (R1.Right - R1.Left = _NonVisualSize) and (R1.Bottom - R1.Top = _NonVisualSize) then begin H2 := GetWindow(ParentHandle, GW_CHILD); H2 := GetWindow(H2, GW_HWNDLAST); while H2 <> 0 do begin if HWndIsNonvisualComponent(H2) and GetWindowRect(H2, R2) then begin if (R2.Top - R1.Top = _NonVisualCaptionV) and (Abs(R2.Left + R2.Right - R1.Left - R1.Right) <= 1) and (R2.Bottom - R2.Top = _NonVisualCaptionSize) then begin Offset.X := R2.Left - R1.Left; Offset.Y := R2.Top - R1.Top; Break; end; end;
H2 := GetWindow(H2, GW_HWNDPREV); end;
Exit; end; end;
H1 := GetWindow(H1, GW_HWNDPREV); end; end;
begin if ObjectIsInheritedFromClass(Form, 'TWidgetControl') then begin ErrorDlg('Ошибка', vSNonNonVisualNotSupport); Exit; end;
P := TSmallPoint(Component.DesignInfo); GetComponentContainerHandle(Form, P.X, P.Y, H1, H2, Offset); Component.DesignInfo := Integer(PointToSmallPoint(Point(X, Y)));
if H1 <> 0 then SetWindowPos(H1, 0, X, Y, 0, 0, SWP_NOSIZE or SWP_NOZORDER); if H2 <> 0 then SetWindowPos(H2, 0, X + Offset.X, Y + Offset.Y, 0, 0, SWP_NOSIZE or SWP_NOZORDER);
end;
procedure TShowPosEditor.ExecuteVerb(Index: Integer); var ADesigner: IDesignerNotify; ALinks: TList; begin case Index of 0: begin ALinks := nil; if ShowPosEditor(TrmCustomHelperLink(Component), ALinks) then try ArrangeComponents(ALinks); finally ALinks.Free; end; end; 1: begin ArrangeComponents; end; end; end;
function TShowPosEditor.GetVerb(Index: Integer): string; begin case Index of 0: Result := _SEditShowPos; 1: Result := _SEditArrangePos; end; end;
function TShowPosEditor.GetVerbCount: Integer; begin if Component is TMasterHelperLink then Result := 2 else Result := 1; end;
|
|