diff --git a/components/sparta/dockedformeditor/language/sparta_strconsts.fr.po b/components/sparta/dockedformeditor/language/sparta_strconsts.fr.po deleted file mode 100644 index 501cb16e16..0000000000 --- a/components/sparta/dockedformeditor/language/sparta_strconsts.fr.po +++ /dev/null @@ -1,24 +0,0 @@ -msgid "" -msgstr "" -"Project-Id-Version: \n" -"POT-Creation-Date: \n" -"PO-Revision-Date: 2016-01-06 17:15+0100\n" -"Last-Translator: Vasseur Gilles \n" -"Language-Team: Vasseur Gilles \n" -"Language: fr_FR\n" -"MIME-Version: 1.0\n" -"Content-Type: text/plain; charset=utf-8\n" -"Content-Transfer-Encoding: 8bit\n" -"X-Poedit-SourceCharset: utf-8\n" -"X-Generator: Poedit 1.8.6\n" - -#: sparta_strconsts.scode -msgctxt "sparta_strconsts.scode" -msgid "Code" -msgstr "Code" - -#: sparta_strconsts.sdesigner -msgctxt "sparta_strconsts.sdesigner" -msgid "Designer" -msgstr "Concepteur" - diff --git a/components/sparta/dockedformeditor/language/sparta_strconsts.hu.po b/components/sparta/dockedformeditor/language/sparta_strconsts.hu.po deleted file mode 100644 index 9d2ef8cf32..0000000000 --- a/components/sparta/dockedformeditor/language/sparta_strconsts.hu.po +++ /dev/null @@ -1,23 +0,0 @@ -msgid "" -msgstr "" -"Project-Id-Version: \n" -"POT-Creation-Date: \n" -"PO-Revision-Date: \n" -"Last-Translator: Péter Gábor \n" -"Language-Team: Magyar (Hungarian)\n" -"Language: hu\n" -"MIME-Version: 1.0\n" -"Content-Type: text/plain; charset=UTF-8\n" -"Content-Transfer-Encoding: 8bit\n" -"X-Generator: Poedit 1.5.4\n" - -#: sparta_strconsts.scode -msgctxt "sparta_strconsts.scode" -msgid "Code" -msgstr "Kód" - -#: sparta_strconsts.sdesigner -msgctxt "sparta_strconsts.sdesigner" -msgid "Designer" -msgstr "Tervező" - diff --git a/components/sparta/dockedformeditor/language/sparta_strconsts.lt.po b/components/sparta/dockedformeditor/language/sparta_strconsts.lt.po deleted file mode 100644 index fab330d660..0000000000 --- a/components/sparta/dockedformeditor/language/sparta_strconsts.lt.po +++ /dev/null @@ -1,24 +0,0 @@ -# Valdas Jankunas , 2017. -msgid "" -msgstr "" -"Last-Translator: Valdas Jankunas \n" -"PO-Revision-Date: 2017-07-05 20:56+0200\n" -"Project-Id-Version: \n" -"Language-Team: Lithuanian \n" -"Language: lt\n" -"Content-Type: text/plain; charset=UTF-8\n" -"Content-Transfer-Encoding: 8bit\n" -"MIME-Version: 1.0\n" -"Plural-Forms: nplurals=3; plural=(n%10==1 && n%100!=11 ? 0 : n%10>=2 && (n%100<10 || n%100>=20) ? 1 : 2);\n" -"X-Generator: Lokalize 2.0\n" - -#: sparta_strconsts.scode -msgctxt "sparta_strconsts.scode" -msgid "Code" -msgstr "Kodas" - -#: sparta_strconsts.sdesigner -msgctxt "sparta_strconsts.sdesigner" -msgid "Designer" -msgstr "Komponuotojas" - diff --git a/components/sparta/dockedformeditor/language/sparta_strconsts.pot b/components/sparta/dockedformeditor/language/sparta_strconsts.pot deleted file mode 100644 index 60fff7552b..0000000000 --- a/components/sparta/dockedformeditor/language/sparta_strconsts.pot +++ /dev/null @@ -1,13 +0,0 @@ -msgid "" -msgstr "Content-Type: text/plain; charset=UTF-8" - -#: sparta_strconsts.scode -msgctxt "sparta_strconsts.scode" -msgid "Code" -msgstr "" - -#: sparta_strconsts.sdesigner -msgctxt "sparta_strconsts.sdesigner" -msgid "Designer" -msgstr "" - diff --git a/components/sparta/dockedformeditor/language/sparta_strconsts.pt_BR.po b/components/sparta/dockedformeditor/language/sparta_strconsts.pt_BR.po deleted file mode 100644 index 47774cbb46..0000000000 --- a/components/sparta/dockedformeditor/language/sparta_strconsts.pt_BR.po +++ /dev/null @@ -1,23 +0,0 @@ -msgid "" -msgstr "" -"Content-Type: text/plain; charset=UTF-8\n" -"Project-Id-Version: \n" -"POT-Creation-Date: \n" -"PO-Revision-Date: \n" -"Last-Translator: Marcelo B Paula \n" -"Language-Team: \n" -"MIME-Version: 1.0\n" -"Content-Transfer-Encoding: 8bit\n" -"Language: pt_BR\n" -"X-Generator: Poedit 1.8.13\n" - -#: sparta_strconsts.scode -msgctxt "sparta_strconsts.scode" -msgid "Code" -msgstr "Código" - -#: sparta_strconsts.sdesigner -msgctxt "sparta_strconsts.sdesigner" -msgid "Designer" -msgstr "Desenho" - diff --git a/components/sparta/dockedformeditor/language/sparta_strconsts.ru.po b/components/sparta/dockedformeditor/language/sparta_strconsts.ru.po deleted file mode 100644 index 5a9cbda5fb..0000000000 --- a/components/sparta/dockedformeditor/language/sparta_strconsts.ru.po +++ /dev/null @@ -1,23 +0,0 @@ -msgid "" -msgstr "" -"Content-Type: text/plain; charset=UTF-8\n" -"Project-Id-Version: \n" -"POT-Creation-Date: \n" -"PO-Revision-Date: \n" -"Last-Translator: Maxim Ganetsky \n" -"Language-Team: \n" -"MIME-Version: 1.0\n" -"Content-Transfer-Encoding: 8bit\n" -"Language: ru\n" -"X-Generator: Poedit 1.7.7\n" - -#: sparta_strconsts.scode -msgctxt "sparta_strconsts.scode" -msgid "Code" -msgstr "Код" - -#: sparta_strconsts.sdesigner -msgctxt "sparta_strconsts.sdesigner" -msgid "Designer" -msgstr "Дизайнер" - diff --git a/components/sparta/dockedformeditor/language/sparta_strconsts.tr.po b/components/sparta/dockedformeditor/language/sparta_strconsts.tr.po deleted file mode 100644 index 95ab9243f5..0000000000 --- a/components/sparta/dockedformeditor/language/sparta_strconsts.tr.po +++ /dev/null @@ -1,23 +0,0 @@ -msgid "" -msgstr "" -"Content-Type: text/plain; charset=UTF-8\n" -"Project-Id-Version: \n" -"POT-Creation-Date: \n" -"PO-Revision-Date: \n" -"Last-Translator: Onur ERÇELEN \n" -"Language-Team: \n" -"MIME-Version: 1.0\n" -"Content-Transfer-Encoding: 8bit\n" -"Language: tr\n" -"X-Generator: Poedit 2.2.3\n" - -#: sparta_strconsts.scode -msgctxt "sparta_strconsts.scode" -msgid "Code" -msgstr "Kod" - -#: sparta_strconsts.sdesigner -msgctxt "sparta_strconsts.sdesigner" -msgid "Designer" -msgstr "Tasarım" - diff --git a/components/sparta/dockedformeditor/language/sparta_strconsts.uk.po b/components/sparta/dockedformeditor/language/sparta_strconsts.uk.po deleted file mode 100644 index 5a9cbda5fb..0000000000 --- a/components/sparta/dockedformeditor/language/sparta_strconsts.uk.po +++ /dev/null @@ -1,23 +0,0 @@ -msgid "" -msgstr "" -"Content-Type: text/plain; charset=UTF-8\n" -"Project-Id-Version: \n" -"POT-Creation-Date: \n" -"PO-Revision-Date: \n" -"Last-Translator: Maxim Ganetsky \n" -"Language-Team: \n" -"MIME-Version: 1.0\n" -"Content-Transfer-Encoding: 8bit\n" -"Language: ru\n" -"X-Generator: Poedit 1.7.7\n" - -#: sparta_strconsts.scode -msgctxt "sparta_strconsts.scode" -msgid "Code" -msgstr "Код" - -#: sparta_strconsts.sdesigner -msgctxt "sparta_strconsts.sdesigner" -msgid "Designer" -msgstr "Дизайнер" - diff --git a/components/sparta/dockedformeditor/language/sparta_strconsts.zh_CN.po b/components/sparta/dockedformeditor/language/sparta_strconsts.zh_CN.po deleted file mode 100644 index ae712edc03..0000000000 --- a/components/sparta/dockedformeditor/language/sparta_strconsts.zh_CN.po +++ /dev/null @@ -1,24 +0,0 @@ -msgid "" -msgstr "" -"Content-Type: text/plain; charset=UTF-8\n" -"Project-Id-Version: X-1.9\n" -"POT-Creation-Date: \n" -"PO-Revision-Date: \n" -"Last-Translator: 郑建平@夏宗萍 aka robsean \n" -"Language-Team: \n" -"MIME-Version: 1.0\n" -"Content-Transfer-Encoding: 8bit\n" -"Language: zh_CN\n" -"X-Generator: Poedit 1.8.7.1\n" -"X-Poedit-SourceCharset: UTF-8\n" - -#: sparta_strconsts.scode -msgctxt "sparta_strconsts.scode" -msgid "Code" -msgstr "代码" - -#: sparta_strconsts.sdesigner -msgctxt "sparta_strconsts.sdesigner" -msgid "Designer" -msgstr "设计" - diff --git a/components/sparta/dockedformeditor/source/sparta_designedform.pas b/components/sparta/dockedformeditor/source/sparta_designedform.pas deleted file mode 100644 index 088460cea1..0000000000 --- a/components/sparta/dockedformeditor/source/sparta_designedform.pas +++ /dev/null @@ -1,56 +0,0 @@ -{ - ***************************************************************************** - See the file COPYING.modifiedLGPL.txt, included in this distribution, - for details about the license. - ***************************************************************************** - - Author: Maciej Izak - - DaThoX 2004-2015 - FreeSparta.com -} - -unit sparta_DesignedForm; - -{$mode objfpc}{$H+} - -interface - -uses - Controls, Forms, SrcEditorIntf, sparta_InterfacesMDI; - -type - IDesignedFormIDE = interface(IDesignedForm) - ['{DFA6C1D8-FA74-443D-B702-82E447F9A111}'] - // for last active window - function GetLastActiveSourceWindow: TSourceEditorWindowInterface; - procedure SetLastActiveSourceWindow(AValue: TSourceEditorWindowInterface); - property LastActiveSourceWindow: TSourceEditorWindowInterface read GetLastActiveSourceWindow write SetLastActiveSourceWindow; - end; - - IDesignedFakeControl = interface - ['{31708772-D9FF-42D8-88AD-D27663393177}'] - end; - - IDesignedFakeForm = interface - ['{A887F50D-13A3-4048-AFFD-F07816FDD08A}'] - // other hacked values - procedure SetFormBorderStyle(ANewStyle: TFormBorderStyle); - procedure SetBorderIcons(AVal: TBorderIcons); - procedure SetFormStyle(AValue : TFormStyle); - procedure SetCaption(const AValue: string); - function GetBorderStyle: TFormBorderStyle; - function GetBorderIcons: TBorderIcons; - function GetFormStyle: TFormStyle; - function GetCaption: string; - - property BorderIcons: TBorderIcons read GetBorderIcons write SetBorderIcons; - property BorderStyle: TFormBorderStyle read GetBorderStyle write SetFormBorderStyle; - property FormStyle: TFormStyle read GetFormStyle write SetFormStyle; - property Caption: string read GetCaption write SetCaption; - end; - -implementation - -end. - diff --git a/components/sparta/dockedformeditor/source/sparta_fakecustom.pas b/components/sparta/dockedformeditor/source/sparta_fakecustom.pas deleted file mode 100644 index 313e38cb0f..0000000000 --- a/components/sparta/dockedformeditor/source/sparta_fakecustom.pas +++ /dev/null @@ -1,744 +0,0 @@ -{ - ***************************************************************************** - See the file COPYING.modifiedLGPL.txt, included in this distribution, - for details about the license. - ***************************************************************************** - - Author: Maciej Izak - - DaThoX 2004-2015 - FreeSparta.com -} - -unit sparta_FakeCustom; - -{$mode delphi}{$H+} - -interface - -uses - Classes, SysUtils, - // LCL - Forms, Controls, - // IdeIntf - FormEditingIntf, SrcEditorIntf, ObjectInspector, - // Sparta - sparta_InterfacesMDI, sparta_DesignedForm, sparta_BasicFakeCustom; - -type - { TDesignedFormImpl } - - TDesignedFormImpl = class(TFormImpl, IDesignedRealForm, IDesignedRealFormHelper, IDesignedForm, IDesignedFormIDE) - private - FLastActiveSourceWindow: TSourceEditorWindowInterface; - protected - function GetLastActiveSourceWindow: TSourceEditorWindowInterface; virtual; - procedure SetLastActiveSourceWindow(AValue: TSourceEditorWindowInterface); virtual; - public - procedure BeginUpdate; override; - procedure EndUpdate(AModified: Boolean = False); override; - end; - - { TFakeCustomForm } - - TFakeCustomForm = class(TForm, IDesignedRealForm, IDesignedForm, IDesignedFormIDE) - private - FDesignedForm: TDesignedFormImpl; - function GetDesignedForm: TDesignedFormImpl; - protected - property DesignedForm: TDesignedFormImpl read GetDesignedForm implements IDesignedForm, IDesignedFormIDE; - function GetLogicalClientRect: TRect; override; - protected - function GetRealBounds(AIndex: Integer): Integer; virtual; - procedure SetRealBounds(AIndex: Integer; AValue: Integer); virtual; - function GetPublishedBounds(AIndex: Integer): Integer; virtual; - procedure SetPublishedBounds(AIndex: Integer; AValue: Integer); virtual; - - procedure SetRealBorderStyle(AVal: TFormBorderStyle); virtual; - procedure SetRealBorderIcons(AVal: TBorderIcons); virtual; - procedure SetRealFormStyle(AVal: TFormStyle); virtual; - procedure SetRealPopupMode(AVal: TPopupMode); virtual; - procedure SetRealPopupParent(AVal: TCustomForm); virtual; - - function GetRealBorderStyle: TFormBorderStyle; virtual; - function GetRealBorderIcons: TBorderIcons; virtual; - function GetRealFormStyle: TFormStyle; virtual; - function GetRealPopupMode: TPopupMode; virtual; - function GetRealPopupParent: TCustomForm; virtual; - public - constructor CreateNew(AOwner: TComponent; Num: Integer = 0); override; - destructor Destroy; override; - published - property Left: Integer index 0 read GetPublishedBounds write SetPublishedBounds; - property Top: Integer index 1 read GetPublishedBounds write SetPublishedBounds; - property Width: Integer index 2 read GetPublishedBounds write SetPublishedBounds; - property Height: Integer index 3 read GetPublishedBounds write SetPublishedBounds; - property ClientWidth: Integer index 2 read GetPublishedBounds write SetPublishedBounds; - property ClientHeight: Integer index 3 read GetPublishedBounds write SetPublishedBounds; - end; - - { TDesignedNonControlFormImpl } - - TDesignedNonControlFormImpl = class(TDesignedFormImpl) - protected - function GetPublishedBounds(AIndex: Integer): Integer; override; - procedure SetPublishedBounds(AIndex: Integer; AValue: Integer); override; - end; - - { TFakeCustomNonControl } - - TFakeCustomNonControl = class(TNonControlProxyDesignerForm, IDesignedRealForm, IDesignedForm, IDesignedFormIDE) - private - FDesignedForm: TDesignedFormImpl; - function GetDesignedForm: TDesignedFormImpl; - protected - property DesignedForm: TDesignedFormImpl read GetDesignedForm implements IDesignedForm, IDesignedFormIDE; - function GetLogicalClientRect: TRect; override; - protected - function GetRealBounds(AIndex: Integer): Integer; virtual; - procedure SetRealBounds(AIndex: Integer; AValue: Integer); virtual; - function GetPublishedBounds(AIndex: Integer): Integer; override; - procedure SetPublishedBounds(AIndex: Integer; AValue: Integer); override; - - procedure SetRealBorderStyle(AVal: TFormBorderStyle); virtual; - procedure SetRealBorderIcons(AVal: TBorderIcons); virtual; - procedure SetRealFormStyle(AVal: TFormStyle); virtual; - procedure SetRealPopupMode(AVal: TPopupMode); virtual; - procedure SetRealPopupParent(AVal: TCustomForm); virtual; - - function GetRealBorderStyle: TFormBorderStyle; virtual; - function GetRealBorderIcons: TBorderIcons; virtual; - function GetRealFormStyle: TFormStyle; virtual; - function GetRealPopupMode: TPopupMode; virtual; - function GetRealPopupParent: TCustomForm; virtual; - protected - procedure SetLookupRoot(AValue: TComponent); override; - procedure SetMediator(AValue: TDesignerMediator); override; - public - constructor Create(AOwner: TComponent; ANonFormDesigner: INonFormDesigner); override; - destructor Destroy; override; - function DockedDesigner: boolean; override; - procedure SetBounds(ALeft, ATop, AWidth, AHeight: integer); override; - end; - - - { TDesignedFrameFormImpl } - - TDesignedFrameFormImpl = class(TDesignedFormImpl) - protected - function GetPublishedBounds(AIndex: Integer): Integer; override; - procedure SetPublishedBounds(AIndex: Integer; AValue: Integer); override; - end; - - { TFakeCustomFrame } - - TFakeCustomFrame = class(TFrameProxyDesignerForm, IDesignedRealForm, IDesignedForm, IDesignedFormIDE) - private - FDesignedForm: TDesignedFormImpl; - function GetDesignedForm: TDesignedFormImpl; - protected - property DesignedForm: TDesignedFormImpl read GetDesignedForm implements IDesignedForm, IDesignedFormIDE; - function GetLogicalClientRect: TRect; override; - protected - function GetRealBounds(AIndex: Integer): Integer; virtual; - procedure SetRealBounds(AIndex: Integer; AValue: Integer); virtual; - function GetPublishedBounds(AIndex: Integer): Integer; override; - procedure SetPublishedBounds(AIndex: Integer; AValue: Integer); override; - - procedure SetRealBorderStyle(AVal: TFormBorderStyle); virtual; - procedure SetRealBorderIcons(AVal: TBorderIcons); virtual; - procedure SetRealFormStyle(AVal: TFormStyle); virtual; - procedure SetRealPopupMode(AVal: TPopupMode); virtual; - procedure SetRealPopupParent(AVal: TCustomForm); virtual; - - function GetRealBorderStyle: TFormBorderStyle; virtual; - function GetRealBorderIcons: TBorderIcons; virtual; - function GetRealFormStyle: TFormStyle; virtual; - function GetRealPopupMode: TPopupMode; virtual; - function GetRealPopupParent: TCustomForm; virtual; - protected - procedure SetLookupRoot(AValue: TComponent); override; - public - constructor Create(AOwner: TComponent; ANonFormDesigner: INonFormDesigner); override; - destructor Destroy; override; - - function DockedDesigner: boolean; override; - end; - -implementation - -uses - sparta_MainIDE; - -type - TFormAccess = class(TForm); - -{ TDesignedNonControlFormImpl } - -function TDesignedNonControlFormImpl.GetPublishedBounds(AIndex: Integer): Integer; -var - LBounds, LClientRect: TRect; - LMediator: TDesignerMediator; - LLookupRoot: TComponent; -begin - LLookupRoot := (FForm as TNonFormProxyDesignerForm).LookupRoot; - if LLookupRoot is TDataModule then - with TDataModule(LLookupRoot) do - case AIndex of - 0: Result := DesignOffset.x; - 1: Result := DesignOffset.y; - 2: Result := DesignSize.x; - 3: Result := DesignSize.y; - end - else - begin - LMediator := (FForm as TNonControlProxyDesignerForm).Mediator; - if (LLookupRoot <> nil) and (LMediator <> nil) then - begin - LMediator.GetFormBounds(LLookupRoot, LBounds, LClientRect); - //WriteLn(Format('get Bounds >>> %d %d %d %d',[LBounds.Left,LBounds.Top,LBounds.Right,LBounds.Bottom])); - //WriteLn(Format('get Client Rect >>> %d %d %d %d',[LClientRect.Left,LClientRect.Top,LClientRect.Right,LClientRect.Bottom])); - case AIndex of - 0: Result := LBounds.Left; - 1: Result := LBounds.Top; - 2: Result := LClientRect.Right; - 3: Result := LClientRect.Bottom; - end; - end - else - Result := 0; //inherited GetPublishedBounds(AIndex); - end -end; - -procedure TDesignedNonControlFormImpl.SetPublishedBounds(AIndex: Integer; - AValue: Integer); -var - LBounds, LClientRect: TRect; - LMediator: TDesignerMediator; - LLookupRoot: TComponent; -begin - LLookupRoot := (FForm as TNonFormProxyDesignerForm).LookupRoot; - if LLookupRoot is TDataModule then - with TDataModule(LLookupRoot) do - case AIndex of - 0: DesignOffset := Point(AValue, DesignOffset.y); - 1: DesignOffset := Point(DesignOffset.x, AValue); - 2: DesignSize := Point(AValue, DesignSize.y); - 3: DesignSize := Point(DesignSize.x, AValue); - end - else - begin - LMediator := (FForm as TNonControlProxyDesignerForm).Mediator; - if (LLookupRoot <> nil) and (LMediator <> nil) then - begin - LMediator.GetFormBounds(LLookupRoot, LBounds, LClientRect); - //WriteLn(Format('set Bounds >>> %d %d %d %d',[LBounds.Left,LBounds.Top,LBounds.Right,LBounds.Bottom])); - //WriteLn(Format('set Client Rect >>> %d %d %d %d',[LClientRect.Left,LClientRect.Top,LClientRect.Right,LClientRect.Bottom])); - case AIndex of - 0: LBounds := Rect(AValue, LBounds.Top, AValue + LClientRect.Right, LBounds.Bottom); - 1: LBounds := Rect(LBounds.Left, AValue, LBounds.Right, AValue + LClientRect.Bottom); - 2: LClientRect := Rect(0, 0, AValue, LClientRect.Bottom); - 3: LClientRect := Rect(0, 0, LClientRect.Right, AValue); - end; - if AIndex in [2, 3] then - LBounds := Rect(LBounds.Left, LBounds.Top, LBounds.Left + LClientRect.Right, LBounds.Top + LClientRect.Bottom); - LMediator.SetFormBounds(LLookupRoot,LBounds,LClientRect); - end; - end; - - // refresh for OI - inherited SetPublishedBounds(AIndex, AValue); -end; - -{ TDesignedFrameFormImpl } - -function TDesignedFrameFormImpl.GetPublishedBounds(AIndex: Integer): Integer; -begin - if (FForm as TNonFormProxyDesignerForm).LookupRoot <> nil then - with (TNonFormProxyDesignerForm(FForm).LookupRoot as TFrame) do - case AIndex of - 0: Result := Left; - 1: Result := Top; - 2: Result := Width; - 3: Result := Height; - end - else - Result:=inherited GetPublishedBounds(AIndex); -end; - -procedure TDesignedFrameFormImpl.SetPublishedBounds(AIndex: Integer; - AValue: Integer); -begin - if (FForm as TNonFormProxyDesignerForm).LookupRoot <> nil then - with (TNonFormProxyDesignerForm(FForm).LookupRoot as TControl) do - case AIndex of - 0: Left := AValue; - 1: Top := AValue; - 2: Width := AValue; - 3: Height := AValue; - end; - - // refresh for OI - inherited SetPublishedBounds(AIndex, AValue); -end; - -{ TFakeCustomFrame } - -function TFakeCustomFrame.GetDesignedForm: TDesignedFormImpl; -begin - if not Assigned(FDesignedForm) then - FDesignedForm := TDesignedFrameFormImpl.Create(Self,Self); - - Result := FDesignedForm; -end; - -function TFakeCustomFrame.GetLogicalClientRect: TRect; -begin - Result := DesignedForm.GetLogicalClientRect(inherited GetLogicalClientRect); -end; - -function TFakeCustomFrame.GetRealBounds(AIndex: Integer): Integer; -begin - Result := inherited GetPublishedBounds(AIndex); -end; - -procedure TFakeCustomFrame.SetRealBounds(AIndex: Integer; AValue: Integer); -begin - inherited SetPublishedBounds(AIndex, AValue); -end; - -function TFakeCustomFrame.GetPublishedBounds(AIndex: Integer): Integer; -begin - Result := DesignedForm.GetPublishedBounds(AIndex); -end; - -procedure TFakeCustomFrame.SetPublishedBounds(AIndex: Integer; AValue: Integer); -begin - //DesignedForm.SetPublishedBounds(AIndex, AValue); - - if LookupRoot <> nil then - with LookupRoot as TControl do - case AIndex of - 0: Left := AValue; - 1: Top := AValue; - 2: Width := AValue; - 3: Height := AValue; - end; -end; - -constructor TFakeCustomFrame.Create(AOwner: TComponent; - ANonFormDesigner: INonFormDesigner); -begin - inherited Create(AOwner, ANonFormDesigner); - - //NonFormDesignerOptions := NonFormDesignerOptions - [nfdokSetBounds]; - - Left := inherited Left; - Top := inherited Top; - Width := inherited Width; - Height := inherited Height; -end; - -destructor TFakeCustomFrame.Destroy; -begin - // we need to call "Screen.RemoveForm" to perform - // references back to nil by IDesignedForm to FDesignedForm - inherited Destroy; - if Assigned(FDesignedForm) then - FDesignedForm.Free; -end; - -function TFakeCustomFrame.DockedDesigner: boolean; -begin - Result := True; -end; - -procedure TFakeCustomFrame.SetRealBorderStyle(AVal: TFormBorderStyle); -begin - inherited BorderStyle := AVal; -end; - -procedure TFakeCustomFrame.SetRealBorderIcons(AVal: TBorderIcons); -begin - inherited BorderIcons := AVal; -end; - -procedure TFakeCustomFrame.SetRealFormStyle(AVal: TFormStyle); -begin - inherited FormStyle := AVal; -end; - -procedure TFakeCustomFrame.SetRealPopupMode(AVal: TPopupMode); -begin - inherited PopupMode := AVal; -end; - -procedure TFakeCustomFrame.SetRealPopupParent(AVal: TCustomForm); -begin - inherited PopupParent := AVal; -end; - -function TFakeCustomFrame.GetRealBorderStyle: TFormBorderStyle; -begin - Result := inherited BorderStyle; -end; - -function TFakeCustomFrame.GetRealBorderIcons: TBorderIcons; -begin - Result := inherited BorderIcons; -end; - -function TFakeCustomFrame.GetRealFormStyle: TFormStyle; -begin - Result := inherited FormStyle; -end; - -function TFakeCustomFrame.GetRealPopupMode: TPopupMode; -begin - Result := inherited PopupMode; -end; - -function TFakeCustomFrame.GetRealPopupParent: TCustomForm; -begin - Result := inherited PopupParent; -end; - -procedure TFakeCustomFrame.SetLookupRoot(AValue: TComponent); -begin - inherited SetLookupRoot(AValue); - - if AValue <> nil then - begin - Left := (LookupRoot as TFrame).Left; - Top := (LookupRoot as TFrame).Top; - Width := (LookupRoot as TFrame).Width; - Height := (LookupRoot as TFrame).Height; - - DesignedForm.RealWidth := Width; - DesignedForm.RealHeight := Height; - end - else - TSpartaMainIDE.TryFreeFormData(Self); -end; - -{ TFakeCustomNonControl } - -function TFakeCustomNonControl.GetDesignedForm: TDesignedFormImpl; -begin - if not Assigned(FDesignedForm) then - FDesignedForm := TDesignedNonControlFormImpl.Create(Self,Self); - - Result := FDesignedForm; -end; - -function TFakeCustomNonControl.GetLogicalClientRect: TRect; -begin - Result := DesignedForm.GetLogicalClientRect(inherited GetLogicalClientRect); -end; - -function TFakeCustomNonControl.GetRealBounds(AIndex: Integer): Integer; -begin - Result := inherited GetPublishedBounds(AIndex); -end; - -procedure TFakeCustomNonControl.SetRealBounds(AIndex: Integer; AValue: Integer); -begin - inherited SetPublishedBounds(AIndex, AValue); -end; - -function TFakeCustomNonControl.GetPublishedBounds(AIndex: Integer): Integer; -begin - Result := DesignedForm.GetPublishedBounds(AIndex); -end; - -procedure TFakeCustomNonControl.SetPublishedBounds(AIndex: Integer; AValue: Integer); -begin - DesignedForm.SetPublishedBounds(AIndex, AValue); -end; - -constructor TFakeCustomNonControl.Create(AOwner: TComponent; - ANonFormDesigner: INonFormDesigner); -begin - inherited Create(AOwner, ANonFormDesigner); - - //NonFormDesignerOptions := []; - - Left := inherited Left; - Top := inherited Top; - Width := inherited Width; - Height := inherited Height; -end; - -destructor TFakeCustomNonControl.Destroy; -begin - // we need to call "Screen.RemoveForm" to perform - // references back to nil by IDesignedForm to FDesignedForm - inherited Destroy; - if Assigned(FDesignedForm) then - FDesignedForm.Free; -end; - -function TFakeCustomNonControl.DockedDesigner: boolean; -begin - Result := True; -end; - -procedure TFakeCustomNonControl.SetBounds(ALeft, ATop, AWidth, AHeight: integer); -begin - SetDesignerFormBounds(ALeft, ATop, AWidth, AHeight); -end; - -procedure TFakeCustomNonControl.SetRealBorderStyle(AVal: TFormBorderStyle); -begin - inherited BorderStyle := AVal; -end; - -procedure TFakeCustomNonControl.SetRealBorderIcons(AVal: TBorderIcons); -begin - inherited BorderIcons := AVal; -end; - -procedure TFakeCustomNonControl.SetRealFormStyle(AVal: TFormStyle); -begin - inherited FormStyle := AVal; -end; - -procedure TFakeCustomNonControl.SetRealPopupMode(AVal: TPopupMode); -begin - inherited PopupMode := AVal; -end; - -procedure TFakeCustomNonControl.SetRealPopupParent(AVal: TCustomForm); -begin - inherited PopupParent := AVal; -end; - -function TFakeCustomNonControl.GetRealBorderStyle: TFormBorderStyle; -begin - Result := inherited BorderStyle; -end; - -function TFakeCustomNonControl.GetRealBorderIcons: TBorderIcons; -begin - Result := inherited BorderIcons; -end; - -function TFakeCustomNonControl.GetRealFormStyle: TFormStyle; -begin - Result := inherited FormStyle; -end; - -function TFakeCustomNonControl.GetRealPopupMode: TPopupMode; -begin - Result := inherited PopupMode; -end; - -function TFakeCustomNonControl.GetRealPopupParent: TCustomForm; -begin - Result := inherited PopupParent; -end; - -procedure TFakeCustomNonControl.SetLookupRoot(AValue: TComponent); -var - LBounds, LClientRect: TRect; -begin - inherited SetLookupRoot(AValue); - - if AValue <> nil then - begin - if LookupRoot is TDataModule then - begin - Width := (LookupRoot as TDataModule).DesignSize.x; - Height := (LookupRoot as TDataModule).DesignSize.y; - end - else if (LookupRoot <> nil) and (Mediator <> nil) then - begin - Mediator.GetFormBounds(LookupRoot,LBounds,LClientRect); - //WriteLn(Format('Bounds >>> %d %d %d %d',[LBounds.Left,LBounds.Top,LBounds.Right,LBounds.Bottom])); - //WriteLn(Format('Client Rect >>> %d %d %d %d',[LClientRect.Left,LClientRect.Top,LClientRect.Right,LClientRect.Bottom])); - Width := LClientRect.Right; - Height := LClientRect.Bottom; - end else - Width := 1; - - DesignedForm.RealWidth := Width; - DesignedForm.RealHeight := Height; - end - else - TSpartaMainIDE.TryFreeFormData(Self); -end; - -procedure TFakeCustomNonControl.SetMediator(AValue: TDesignerMediator); -var - LBounds, LClientRect: TRect; -begin - inherited SetMediator(AValue); - - if (LookupRoot <> nil) and (Mediator <> nil) then - begin - Mediator.GetFormBounds(LookupRoot,LBounds,LClientRect); - //WriteLn(Format('Bounds >>> %d %d %d %d',[LBounds.Left,LBounds.Top,LBounds.Right,LBounds.Bottom])); - //WriteLn(Format('Client Rect >>> %d %d %d %d',[LClientRect.Left,LClientRect.Top,LClientRect.Right,LClientRect.Bottom])); - Width := LClientRect.Right; - Height := LClientRect.Bottom; - end else - ;//WriteLn('o kurwa eh'); -end; - -{ TFakeCustomForm } - -function TFakeCustomForm.GetDesignedForm: TDesignedFormImpl; -begin - if not Assigned(FDesignedForm) then - FDesignedForm := TDesignedFormImpl.Create(Self,Self); - - Result := FDesignedForm; -end; - -function TFakeCustomForm.GetLogicalClientRect: TRect; -begin - Result := DesignedForm.GetLogicalClientRect(inherited GetLogicalClientRect); -end; - -function TFakeCustomForm.GetRealBounds(AIndex: Integer): Integer; -begin - case AIndex of - 0: Result := inherited Left; - 1: Result := inherited Top; - 2: Result := inherited Width; - 3: Result := inherited Height; - end; -end; - -procedure TFakeCustomForm.SetRealBounds(AIndex: Integer; AValue: Integer); -begin - case AIndex of - 0: inherited Left := AValue; - 1: inherited Top := AValue; - 2: inherited Width := AValue; - 3: inherited Height := AValue; - end; -end; - -function TFakeCustomForm.GetPublishedBounds(AIndex: Integer): Integer; -begin - Result := DesignedForm.GetPublishedBounds(AIndex); -end; - -procedure TFakeCustomForm.SetPublishedBounds(AIndex: Integer; AValue: Integer); -begin - case AIndex of - 0, 1: DesignedForm.SetPublishedBounds(AIndex, AValue); - 2, 3: - begin - DesignedForm.SetPublishedBounds(AIndex, AValue); - SetRealBounds(AIndex, DesignedForm.GetPublishedBounds(AIndex)); - end; - end; -end; - -constructor TFakeCustomForm.CreateNew(AOwner: TComponent; Num: Integer); -begin - inherited CreateNew(AOwner, Num); - - Left := inherited Left; - Top := inherited Top; - Width := inherited Width; - Height := inherited Height; -end; - -destructor TFakeCustomForm.Destroy; -begin - // we need to call "Screen.RemoveForm" to perform - // references back to nil by IDesignedForm to FDesignedForm - inherited Destroy; - if Assigned(FDesignedForm) then - FreeAndNil(FDesignedForm); -end; - -procedure TFakeCustomForm.SetRealBorderStyle(AVal: TFormBorderStyle); -begin - inherited BorderStyle := AVal; -end; - -procedure TFakeCustomForm.SetRealBorderIcons(AVal: TBorderIcons); -begin - inherited BorderIcons := AVal; -end; - -procedure TFakeCustomForm.SetRealFormStyle(AVal: TFormStyle); -begin - inherited FormStyle := AVal; -end; - -procedure TFakeCustomForm.SetRealPopupMode(AVal: TPopupMode); -begin - inherited PopupMode := AVal; -end; - -procedure TFakeCustomForm.SetRealPopupParent(AVal: TCustomForm); -begin - inherited PopupParent := AVal; -end; - -function TFakeCustomForm.GetRealBorderStyle: TFormBorderStyle; -begin - Result := inherited BorderStyle; -end; - -function TFakeCustomForm.GetRealBorderIcons: TBorderIcons; -begin - Result := inherited BorderIcons; -end; - -function TFakeCustomForm.GetRealFormStyle: TFormStyle; -begin - Result := inherited FormStyle; -end; - -function TFakeCustomForm.GetRealPopupMode: TPopupMode; -begin - Result := inherited PopupMode; -end; - -function TFakeCustomForm.GetRealPopupParent: TCustomForm; -begin - Result := inherited PopupParent; -end; - -{ TDesignedFormImpl } - -function TDesignedFormImpl.GetLastActiveSourceWindow: TSourceEditorWindowInterface; -begin - Result := FLastActiveSourceWindow; -end; - -procedure TDesignedFormImpl.SetLastActiveSourceWindow( - AValue: TSourceEditorWindowInterface); -begin - FLastActiveSourceWindow := AValue; -end; - -procedure TDesignedFormImpl.BeginUpdate; -begin - TFormAccess(FForm).SetDesigning(False, False); - inherited BeginUpdate; -end; - -procedure TDesignedFormImpl.EndUpdate(AModified: Boolean); -var - OI: TObjectInspectorDlg; -begin - TFormAccess(FForm).SetDesigning(True, False); - inherited EndUpdate(AModified); - if AModified and (FormEditingHook <> nil) - and (FormEditingHook.GetCurrentDesigner = FForm.Designer) then - begin - OI := FormEditingHook.GetCurrentObjectInspector; - if Assigned(OI) then - OI.RefreshPropertyValues; - end; -end; - -end. - diff --git a/components/sparta/dockedformeditor/source/sparta_fakeform.pas b/components/sparta/dockedformeditor/source/sparta_fakeform.pas deleted file mode 100644 index 9eaa020f1c..0000000000 --- a/components/sparta/dockedformeditor/source/sparta_fakeform.pas +++ /dev/null @@ -1,274 +0,0 @@ -{ - ***************************************************************************** - See the file COPYING.modifiedLGPL.txt, included in this distribution, - for details about the license. - ***************************************************************************** - - Author: Maciej Izak - - DaThoX 2004-2015 - FreeSparta.com -} - -unit sparta_FakeForm; - -{$mode delphi}{$H+} - -interface - -uses - Classes, SysUtils, - // LCL - Forms, Controls, - // Sparta - sparta_DesignedForm, sparta_FakeCustom; - - -const - BorderStylesAllowAutoScroll = [bsSizeable, bsSizeToolWin]; - -type - { TFakeForm } - - TFakeForm = class(TFakeCustomForm, IDesignedFakeForm) - private - FHackAlign: TAlign; - FHackAnchors: TAnchors; - FHackVisible: Boolean; - FHackAutoScroll: Boolean; - FHackBorderStyle: TFormBorderStyle; - FHackBorderIcons: TBorderIcons; - FHackFormStyle: TFormStyle; - - FPopupMode: TPopupMode; - FPopupParent: TCustomForm; - - FHorzScrollBar: TControlScrollBar; - FVertScrollBar: TControlScrollBar; - - FControlForHackedConstraints: TControl; - FHackConstraints: TSizeConstraints; - - function IsAnchorsStored: Boolean; - function IsAutoScrollStored: Boolean; - procedure SetAlign(Value: TAlign); - procedure SetAnchors(const AValue: TAnchors); - procedure SetHorzScrollBar(AValue: TControlScrollBar); - procedure SetVertScrollBar(AValue: TControlScrollBar); - procedure SetPopupMode(const AValue: TPopupMode); - procedure SetPopupParent(const AValue: TCustomForm); - - procedure SetFormBorderStyle(ANewStyle: TFormBorderStyle); - procedure SetBorderIcons(AVal: TBorderIcons); - procedure SetFormStyle(AValue : TFormStyle); - procedure SetCaption(const AValue: string); - function GetBorderStyle: TFormBorderStyle; - function GetBorderIcons: TBorderIcons; - function GetFormStyle: TFormStyle; - function GetCaption: string; - public - property RealPopupMode: TPopupMode read GetRealPopupMode write SetRealPopupMode; - property RealPopupParent: TCustomForm read GetRealPopupParent write SetRealPopupParent; - - constructor CreateNew(AOwner: TComponent; Num: Integer = 0); override; - destructor Destroy; override; - published - property Align: TAlign read FHackAlign write SetAlign default alNone; - property Anchors: TAnchors read FHackAnchors write SetAnchors stored IsAnchorsStored default [akLeft, akTop]; - property AutoScroll: Boolean read FHackAutoScroll write FHackAutoScroll stored IsAutoScrollStored default False; - property BorderIcons: TBorderIcons read GetBorderIcons write SetBorderIcons default [biSystemMenu, biMinimize, biMaximize]; - property BorderStyle: TFormBorderStyle read GetBorderStyle write SetFormBorderStyle default bsSizeable; - property FormStyle: TFormStyle read GetFormStyle write SetFormStyle default fsNormal; - - property PopupMode: TPopupMode read FPopupMode write SetPopupMode default pmNone; - property PopupParent: TCustomForm read FPopupParent write SetPopupParent; - - property HorzScrollBar: TControlScrollBar read FHorzScrollBar write SetHorzScrollBar; - property VertScrollBar: TControlScrollBar read FVertScrollBar write SetVertScrollBar; - - property Constraints: TSizeConstraints read FHackConstraints write FHackConstraints; - property Caption: string read GetCaption write SetCaption; - property Visible: boolean read FHackVisible write FHackVisible; - end; - -implementation - -{ TFakeForm } - -procedure TFakeForm.SetHorzScrollBar(AValue: TControlScrollBar); -begin - FHorzScrollBar.Assign(AValue); -end; - -function TFakeForm.IsAutoScrollStored: Boolean; -begin - Result := BorderStyle in BorderStylesAllowAutoScroll; -end; - -function TFakeForm.IsAnchorsStored: Boolean; -begin - Result:=(Anchors<>AnchorAlign[Align]); -end; - -procedure TFakeForm.SetAlign(Value: TAlign); -var - OldAlign: TAlign; - a: TAnchorKind; -begin - if FHackAlign = Value then exit; - OldAlign := FHackAlign; - FHackAlign := Value; - if (not (csLoading in ComponentState)) - and (Align in [alLeft,alTop,alRight,alBottom,alClient]) then begin - // Align for alLeft,alTop,alRight,alBottom,alClient takes precedence - // over AnchorSides => clean up - for a:=low(TAnchorKind) to High(TAnchorKind) do - begin - if not (a in AnchorAlign[FHackAlign]) then continue; - AnchorSide[a].Control:=nil; - AnchorSide[a].Side:=asrTop; - end; - end; - - // Notes: - // - if anchors had default values then change them to new default values - // This is done for Delphi compatibility. - // - Anchors are not stored if they are AnchorAlign[Align] - if (Anchors = AnchorAlign[OldAlign]) and (Anchors <> AnchorAlign[FHackAlign]) then - Anchors := AnchorAlign[FHackAlign]; -end; - -procedure TFakeForm.SetAnchors(const AValue: TAnchors); -var - NewAnchors: TAnchors; - a: TAnchorKind; -begin - if Anchors = AValue then Exit; - NewAnchors:=AValue-FHackAnchors; - FHackAnchors := AValue; - for a:=Low(TAnchorKind) to high(TAnchorKind) do - if (a in NewAnchors) and (AnchorSide[a].Side=asrCenter) then - AnchorSide[a].FixCenterAnchoring; -end; - -procedure TFakeForm.SetFormBorderStyle(ANewStyle: TFormBorderStyle); -begin - if FHackBorderStyle = ANewStyle then exit; - - if not (ANewStyle in BorderStylesAllowAutoScroll) then - AutoScroll := False; - - FHackBorderStyle := ANewStyle; -end; - -procedure TFakeForm.SetBorderIcons(AVal: TBorderIcons); -begin - FHackBorderIcons := AVal; -end; - -procedure TFakeForm.SetFormStyle(AValue: TFormStyle); -var - LHackFormStyle: TFormStyle; -Begin - if FHackFormStyle = AValue then - exit; - - LHackFormStyle := FHackFormStyle; - FHackFormStyle := AValue; - - if FHackFormStyle = fsSplash then - BorderStyle := bsNone - else - if LHackFormStyle = fsSplash then - BorderStyle := bsSizeable; -end; - -procedure TFakeForm.SetCaption(const AValue: string); -begin - inherited Caption := AValue; -end; - -procedure TFakeForm.SetPopupMode(const AValue: TPopupMode); -begin - if FPopupMode <> AValue then - begin - FPopupMode := AValue; - if FPopupMode = pmAuto then - PopupParent := nil; - end; -end; - -procedure TFakeForm.SetPopupParent(const AValue: TCustomForm); -begin - if FPopupParent <> AValue then - begin - if FPopupParent <> nil then - FPopupParent.RemoveFreeNotification(Self); - FPopupParent := AValue; - if FPopupParent <> nil then - begin - FPopupParent.FreeNotification(Self); - FPopupMode := pmExplicit; - end; - end; -end; - - -function TFakeForm.GetBorderStyle: TFormBorderStyle; -begin - Result := FHackBorderStyle; -end; - -function TFakeForm.GetBorderIcons: TBorderIcons; -begin - Result := FHackBorderIcons; -end; - -function TFakeForm.GetFormStyle: TFormStyle; -begin - Result := FHackFormStyle; -end; - -function TFakeForm.GetCaption: string; -begin - Result := inherited Caption; -end; - -procedure TFakeForm.SetVertScrollBar(AValue: TControlScrollBar); -begin - FVertScrollBar.Assign(AValue); -end; - -constructor TFakeForm.CreateNew(AOwner: TComponent; Num: Integer); -begin - inherited CreateNew(AOwner, Num); - - FHorzScrollBar := TControlScrollBar.Create(Self, sbHorizontal); - FVertScrollBar := TControlScrollBar.Create(Self, sbVertical); - - BorderIcons := inherited BorderIcons; - BorderStyle := inherited BorderStyle; - FormStyle := inherited FormStyle; - - PopupMode := inherited PopupMode; - - FControlForHackedConstraints := TControl.Create(nil); - FHackConstraints := TSizeConstraints.Create(FControlForHackedConstraints); - - FHackAnchors := [akLeft,akTop]; - FHackAlign := alNone; -end; - -destructor TFakeForm.Destroy; -begin - FHorzScrollBar.Free; - FVertScrollBar.Free; - - FHackConstraints.Free; - FControlForHackedConstraints.Free; - - inherited Destroy; -end; - -end. - diff --git a/components/sparta/dockedformeditor/source/sparta_fakeframe.pas b/components/sparta/dockedformeditor/source/sparta_fakeframe.pas deleted file mode 100644 index c1a442c141..0000000000 --- a/components/sparta/dockedformeditor/source/sparta_fakeframe.pas +++ /dev/null @@ -1,134 +0,0 @@ -{ - ***************************************************************************** - See the file COPYING.modifiedLGPL.txt, included in this distribution, - for details about the license. - ***************************************************************************** - - Author: Maciej Izak - - DaThoX 2004-2015 - FreeSparta.com -} - -unit sparta_FakeFrame; - -{$mode objfpc}{$H+} - -interface - -uses - Classes, SysUtils, - // LCL - Controls, Forms, - // Sparta - sparta_FakeCustom; - -type - TFakeFrame = class(TFakeCustomFrame) - end; - - { THookFrame - temporary name need refactoring } - - THookFrame = class(TFrame) - private - FHackAlign: TAlign; - FHackAnchors: TAnchors; - - function IsAnchorsStored: Boolean; - function GetAlign: TAlign; - procedure SetAlign(Value: TAlign); - function GetAnchors: TAnchors; - procedure SetAnchors(const AValue: TAnchors); - public - constructor Create(TheOwner: TComponent); override; - published - property Align: TAlign read GetAlign write SetAlign default alNone; - property Anchors: TAnchors read GetAnchors write SetAnchors stored IsAnchorsStored default [akLeft, akTop]; - end; - -implementation - - - -{ THookFrame } - -function THookFrame.IsAnchorsStored: Boolean; -begin - Result:=(Anchors<>AnchorAlign[Align]); -end; - -function THookFrame.GetAlign: TAlign; -begin - if not (csDesignInstance in ComponentState) then - Result := inherited Align - else - Result := FHackAlign; -end; - -procedure THookFrame.SetAlign(Value: TAlign); -var - OldAlign: TAlign; - a: TAnchorKind; -begin - if not (csDesignInstance in ComponentState) then - inherited Align := Value - else begin - if FHackAlign = Value then exit; - OldAlign := FHackAlign; - FHackAlign := Value; - if (not (csLoading in ComponentState)) - and (Align in [alLeft,alTop,alRight,alBottom,alClient]) then begin - // Align for alLeft,alTop,alRight,alBottom,alClient takes precedence - // over AnchorSides => clean up - for a:=low(TAnchorKind) to High(TAnchorKind) do - begin - if not (a in AnchorAlign[FHackAlign]) then continue; - AnchorSide[a].Control:=nil; - AnchorSide[a].Side:=asrTop; - end; - end; - - // Notes: - // - if anchors had default values then change them to new default values - // This is done for Delphi compatibility. - // - Anchors are not stored if they are AnchorAlign[Align] - if (Anchors = AnchorAlign[OldAlign]) and (Anchors <> AnchorAlign[FHackAlign]) then - Anchors := AnchorAlign[FHackAlign]; - end; -end; - -function THookFrame.GetAnchors: TAnchors; -begin - if not (csDesignInstance in ComponentState) then - Result := inherited Anchors - else - Result := FHackAnchors; -end; - -procedure THookFrame.SetAnchors(const AValue: TAnchors); -var - NewAnchors: TAnchors; - a: TAnchorKind; -begin - if not (csDesignInstance in ComponentState) then - inherited Anchors := AValue - else begin - if Anchors = AValue then Exit; - NewAnchors:=AValue-FHackAnchors; - FHackAnchors := AValue; - for a:=Low(TAnchorKind) to high(TAnchorKind) do - if (a in NewAnchors) and (AnchorSide[a].Side=asrCenter) then - AnchorSide[a].FixCenterAnchoring; - end; -end; - -constructor THookFrame.Create(TheOwner: TComponent); -begin - inherited Create(TheOwner); - - FHackAnchors := [akLeft,akTop]; - FHackAlign := alNone; -end; - -end. - diff --git a/components/sparta/dockedformeditor/source/sparta_fakenoncontrol.pas b/components/sparta/dockedformeditor/source/sparta_fakenoncontrol.pas deleted file mode 100644 index 3d91f0e7c9..0000000000 --- a/components/sparta/dockedformeditor/source/sparta_fakenoncontrol.pas +++ /dev/null @@ -1,29 +0,0 @@ -{ - ***************************************************************************** - See the file COPYING.modifiedLGPL.txt, included in this distribution, - for details about the license. - ***************************************************************************** - - Author: Maciej Izak - - DaThoX 2004-2015 - FreeSparta.com -} - -unit sparta_FakeNonControl; - -{$mode objfpc}{$H+} - -interface - -uses - sparta_FakeCustom; - -type - TFakeNonControl = class(TFakeCustomNonControl) - end; - -implementation - -end. - diff --git a/components/sparta/dockedformeditor/source/sparta_mainide.pas b/components/sparta/dockedformeditor/source/sparta_mainide.pas deleted file mode 100644 index a48eee8b3f..0000000000 --- a/components/sparta/dockedformeditor/source/sparta_mainide.pas +++ /dev/null @@ -1,1360 +0,0 @@ -{ - ***************************************************************************** - See the file COPYING.modifiedLGPL.txt, included in this distribution, - for details about the license. - ***************************************************************************** - - Author: Maciej Izak - - DaThoX 2004-2015 - FreeSparta.com -} - -unit sparta_MainIDE; - -{$mode delphi}{$H+} - -interface - -uses - Classes, SysUtils, - Generics.Collections, Generics.Defaults, - contnrs, - // LCL - LCLIntf, LCLType, LMessages, ComCtrls, Controls, Forms, ExtCtrls, Graphics, - // IdeIntf - SrcEditorIntf, LazIDEIntf, FormEditingIntf, PropEdits, PropEditUtils, ComponentEditors, - // Sparta - sparta_InterfacesMDI, sparta_strconsts, sparta_DesignedForm, sparta_resizer, - sparta_FakeForm, sparta_FakeFrame, sparta_FakeCustom; - -const - WM_SETNOFRAME = WM_USER; - WM_BOUNDTODESIGNTABSHEET = WM_USER + 1; - -type - { TDesignFormData } - - TDesignFormData = class(TComponent, IDesignedForm, IDesignedFormIDE) - private - FWndMethod: TWndMethod; - FForm: IDesignedFormIDE; - FLastScreenshot: TBitmap; - FPopupParent: TSourceEditorWindowInterface; - FHiding: boolean; - FFormImages: TList; - procedure WndMethod(var Msg: TLMessage); - procedure SetPopupParent(AVal: TSourceEditorWindowInterface); - procedure DoAddForm; - procedure FormChangeBounds(Sender: TObject); - public - class var AddFormEvents: TList; - class constructor Init; - class destructor Finit; - procedure AddFormImage(AImage: TImage); - procedure RemoveFormImage(AImage: TImage); - procedure RepaintFormImages; - - property Form: IDesignedFormIDE read FForm implements IDesignedForm, IDesignedFormIDE; - property LastScreenshot: TBitmap read FLastScreenshot; - property PopupParent: TSourceEditorWindowInterface read FPopupParent write SetPopupParent; - - constructor Create(AForm: TCustomForm); reintroduce; - destructor Destroy; override; - end; - - { TModulePageControl } - - TModulePageControl = class(TPageControl) - private - FResizer: TResizer; - FDesignFormData: TDesignFormData; - protected - procedure SetDesignFormData(const AValue: TDesignFormData); virtual; - public - destructor Destroy; override; - procedure ShowDesignPage; - procedure HideDesignPage; - procedure BoundToDesignTabSheet; - - property Resizer: TResizer read FResizer; - property DesignFormData: TDesignFormData read FDesignFormData write SetDesignFormData; - end; - - { TSourceEditorWindowData } - - TSourceEditorWindowData = class - private - FActiveDesignFormData: TDesignFormData; - FForm: TSourceEditorWindowInterface; - FPageCtrlList: TDictionary; - FLastTopParent: TControl; - - procedure SetActiveDesignFormData(const AValue: TDesignFormData); - procedure OnChangeBounds(Sender: TObject); - procedure AddPageCtrl(ASrcEditor: TSourceEditorInterface; APage: TModulePageControl); - procedure RemovePageCtrl(ASrcEditor: TSourceEditorInterface); - public - constructor Create(AForm: TSourceEditorWindowInterface); - destructor Destroy; override; - property ActiveDesignFormData: TDesignFormData read FActiveDesignFormData write SetActiveDesignFormData; - procedure BoundToDesignTabSheet; - end; - - { TDTXTabMaster } - - TDTXTabMaster = class(TIDETabMaster) - private - FAutoSizeControlList: TObjectList; - protected - function GetTabDisplayState: TTabDisplayState; override; - function GetTabDisplayStateEditor(Index: TSourceEditorInterface): TTabDisplayState; override; - public - constructor Create; - destructor Destroy; override; - function AutoSizeInShowDesigner(AControl: TControl): Boolean; override; - procedure EnableAutoSizing(AControl: TControl); - procedure ToggleFormUnit; override; - procedure JumpToCompilerMessage(ASourceEditor: TSourceEditorInterface); override; - - procedure ShowCode(ASourceEditor: TSourceEditorInterface); override; - procedure ShowDesigner(ASourceEditor: TSourceEditorInterface; {%H-}AIndex: Integer = 0); override; - procedure ShowForm(AForm: TCustomForm); override; - end; - - { TDTXComponentsMaster } - - TDTXComponentsMaster = class(TIDEComponentsMaster) - function DrawNonVisualComponents(ALookupRoot: TComponent): Boolean; override; - end; - - TFormHack = class(TCustomForm); - - { TSpartaMainIDE } - - TSpartaMainIDE = class(TObject) - public - class function GetCurrentResizer: TResizer; - class procedure TryFreeFormData(Form: TCustomForm); - - class procedure Screen_FormAdded(Sender: TObject; Form: TCustomForm); - class procedure Screen_FormDel(Sender: TObject; Form: TCustomForm); - - class procedure WindowCreate(Sender: TObject); - class procedure WindowDestroy(Sender: TObject); - class procedure WindowShow(Sender: TObject); - class procedure WindowHide(Sender: TObject); - - class procedure EditorActivated(Sender: TObject); - class procedure EditorDestroyed(Sender: TObject); - class procedure EditorCreate(Sender: TObject); - - class procedure TabChange(Sender: TObject); - - class procedure GlobalOnChangeBounds(Sender: TObject); - class procedure GlobalSNOnChangeBounds(Sender: TObject); - class procedure OnShowDesignerForm(Sender: TObject; {%H-}AEditor: TSourceEditorInterface; - AComponentPaletteClassSelected: Boolean); - class procedure OnShowSrcEditor(Sender: TObject); - - class procedure OnShowMethod(const Name: String); - class procedure OnDesignRefreshPropertyValues; - class procedure OnModifiedPersistentAdded({%H-}APersistent: TPersistent; {%H-}Select: Boolean); - class procedure OnModifiedSender(Sender: TObject); - class procedure OnModified(APersistent: TPersistent); - class procedure DesignerSetFocus; - class procedure OnDesignMouseDown(Sender: TObject; {%H-}Button: TMouseButton; - {%H-}Shift: TShiftState; {%H-}X, {%H-}Y: Integer); - end; - -var - normForms: Classes.TList; // normal forms - dsgnForms: Classes.TList; // design forms - SourceEditorWindows: TObjectDictionary; - LastActiveSourceEditorWindow: TSourceEditorWindowInterface = nil; - LastActiveSourceEditor: TSourceEditorInterface = nil; - BoundInitialized: Boolean; - -function FindModulePageControl(AForm: TSourceEditorWindowInterface): TModulePageControl; overload; -function FindSourceEditorForDesigner(ADesigner: TIDesigner): TSourceEditorInterface; - -implementation - -uses - sparta_ResizerFrame; - -// FUTURE USE -// -//function FindDesignForm(ADesigner: TIDesigner): TCustomForm; -//var -// f: TDesignFormData; -//begin -// for Pointer(f) in dsgnForms do -// with f as IDesignedForm do -// if Form.Designer = ADesigner then -// Exit(Form); -// -// Result := nil; -//end; -// -//function FindDesignFormData(AForm: TSourceEditorWindowInterface): TDesignFormData; overload; -//begin -// Result := FindDesignFormData( -// FindModulePageControl(AForm) -// ); -//end; -// -//procedure HideAllForms; -//var -// f: TDesignFormData; -//begin -// for Pointer(f) in dsgnForms do -// ShowWindow(f.Form.Form.Handle, SW_HIDE); -//end; - -function FindModulePageControl(ASourceEditor: TSourceEditorInterface): TModulePageControl; overload; -var - LParent: TWinControl; -begin - if ASourceEditor = nil then - Exit(nil); - LParent := ASourceEditor.EditorControl.Parent; - while LParent <> nil do - begin - if LParent is TModulePageControl then - Exit(TModulePageControl(LParent)); - LParent := LParent.Parent; - end; - Result := nil; -end; - -function FindModulePageControl(AForm: TSourceEditorWindowInterface): TModulePageControl; overload; -begin - Result := FindModulePageControl(AForm.ActiveEditor); -end; - -function AbsoluteFindModulePageControl(ASrcEditor: TSourceEditorInterface): TModulePageControl; -var - LSEWD: TSourceEditorWindowData; -begin - Result := nil; - for LSEWD in SourceEditorWindows.Values do - if LSEWD.FPageCtrlList.ContainsKey(ASrcEditor) then - Exit(LSEWD.FPageCtrlList[ASrcEditor]); -end; - -function FindSourceEditorForDesigner(ADesigner: TIDesigner): TSourceEditorInterface; -var - i: Integer; -begin - for i := 0 to SourceEditorManagerIntf.SourceEditorCount - 1 do - if SourceEditorManagerIntf.SourceEditors[i].GetDesigner(False) = ADesigner then - Exit(SourceEditorManagerIntf.SourceEditors[i]); - Result := nil; -end; - -function FindDesignFormData(ADesigner: TIDesigner): TDesignFormData; overload; -var - p: Pointer; - f: TDesignFormData absolute p; - fi: IDesignedForm = nil; -begin - Result := nil; - if ADesigner = nil then - Exit; - for p in dsgnForms do - begin - fi := f.FForm; - if (fi.Form.Designer = ADesigner) then - Exit(f); - end; -end; - -procedure RefreshAllSourceWindowsModulePageControl; -var - LWindow: TSourceEditorWindowInterface; - LPageCtrl: TModulePageControl; -begin - for LWindow in SourceEditorWindows.Keys do - begin - LPageCtrl := FindModulePageControl(LWindow); - // for example LPageCtrl is nil when we clone module to new window - if (LPageCtrl = nil) or (csDestroying in LWindow.ComponentState) then - Continue; - if LWindow.ActiveEditor = nil then - LPageCtrl.HideDesignPage - else - if LWindow.ActiveEditor.GetDesigner(True) <> nil then - // TODO some check function: is displayed right form? - LPageCtrl.ShowDesignPage - else - LPageCtrl.HideDesignPage; - end; -end; - -// sometimes at some level of initialization form can not contain TIDesigner -// (during ide run and when is oppened default project with some TForm1) -function FindDesignFormData(AForm: TCustomForm): TDesignFormData; overload; -var - f: TDesignFormData; -begin - Result := nil; - if AForm = nil then - Exit; - for Pointer(f) in dsgnForms do - if (f as IDesignedForm).Form = AForm then - Exit(f); -end; - -function FindDesignFormData(AModulePageCtrl: TModulePageControl): TDesignFormData; overload; -var - LSourceWindow: TSourceEditorWindowInterface; - LSourceEditor: TSourceEditorInterface; -begin - Result := nil; - if AModulePageCtrl = nil then - Exit; - for LSourceWindow in SourceEditorWindows.Keys do - begin - if AModulePageCtrl.Owner = LSourceWindow then - begin - LSourceEditor := LSourceWindow.ActiveEditor; - if LSourceEditor = nil then - Exit; - Result := FindDesignFormData(LSourceEditor.GetDesigner(True)); - Exit; - end; - end; -end; - -{ TDesignFormData } - -procedure TDesignFormData.WndMethod(var Msg: TLMessage); - - // Without this button F12 don't work. (after creating new for editor is inactive) :< - procedure FixF12_ActiveEditor; - var - i: Integer; - begin - // Just do it for new created forms or the last loaded form becomes the active - // source editor after reopening a project. - if Form.Form.Designer <> SourceEditorManagerIntf.ActiveEditor.GetDesigner(True) then Exit; - - SourceEditorManagerIntf.ActiveEditor := nil; - for i := 0 to SourceEditorManagerIntf.UniqueSourceEditorCount - 1 do - if Form.Form.Designer = SourceEditorManagerIntf.UniqueSourceEditors[i].GetDesigner(True) then - begin - SourceEditorManagerIntf.ActiveEditor := SourceEditorManagerIntf.UniqueSourceEditors[i]; - Break; - end; - end; - -var - Timer: TLMTimer; -begin - if Msg.msg = LM_TIMER then - begin - Timer := TLMTimer(Msg); - if Timer.TimerID = WM_SETNOFRAME then - begin - KillTimer(FForm.Form.Handle, WM_SETNOFRAME); - ShowWindow(Form.Form.Handle, SW_HIDE); - FHiding := False; - FixF12_ActiveEditor; - if Form.Form is TFakeForm then - RepaintFormImages; - Exit; - end; - if Timer.TimerID = WM_BOUNDTODESIGNTABSHEET then - begin - KillTimer(FForm.Form.Handle, WM_BOUNDTODESIGNTABSHEET); - SourceEditorWindows[Form.LastActiveSourceWindow].BoundToDesignTabSheet; - Exit; - end; - end; - - // we need to correct ActiveEditor to right form - // this code works correctly on Windows platform - // (is necessery for selecting controls after form resizing). - // in Linux platforms below code brings problems with QT (inactive form) - {$IFDEF WINDOWS} - case Msg.msg of - LM_LBUTTONDOWN, LM_RBUTTONDOWN, LM_MBUTTONDOWN, LM_XBUTTONDOWN: - if Form.LastActiveSourceWindow <> nil then - begin - SourceEditorManagerIntf.ActiveSourceWindow := Form.LastActiveSourceWindow; - SourceEditorManagerIntf.ActiveEditor := Form.LastActiveSourceWindow.ActiveEditor; - end; - end; - {$ENDIF} - - FWndMethod(Msg); -end; - -procedure TDesignFormData.SetPopupParent(AVal: TSourceEditorWindowInterface); -begin - FPopupParent := AVal; - Form.RealPopupParent := FPopupParent; -end; - -class constructor TDesignFormData.Init; -begin - AddFormEvents := TList.Create; -end; - -class destructor TDesignFormData.Finit; -begin - AddFormEvents.Free; -end; - -procedure TDesignFormData.AddFormImage(AImage: TImage); -begin - if FFormImages <> nil then - FFormImages.Add(AImage); -end; - -procedure TDesignFormData.RemoveFormImage(AImage: TImage); -begin - if FFormImages <> nil then - FFormImages.Remove(AImage); -end; - -procedure TDesignFormData.RepaintFormImages; -var - LImage: TImage; -begin - if FFormImages <> nil then - for LImage in FFormImages do - LImage.OnResize(LImage); -end; - -procedure TDesignFormData.DoAddForm; -var - ne: TNotifyEvent; -begin - for ne in AddFormEvents do - ne(Self); -end; - -procedure TDesignFormData.FormChangeBounds(Sender: TObject); -begin - if not FForm.Update then - SetTimer(FForm.Form.Handle, WM_BOUNDTODESIGNTABSHEET, 10, nil); -end; - -constructor TDesignFormData.Create(AForm: TCustomForm); -begin - FForm := TDesignedFormImpl.Create(Self, AForm); - AForm.AddHandlerOnChangeBounds(FormChangeBounds); - - FLastScreenshot := TBitmap.Create; - FWndMethod := FForm.Form.WindowProc; - FForm.Form.WindowProc := WndMethod; - - if FForm.Form is TFakeForm then - begin - FFormImages := TList.Create; - DoAddForm; - end; -end; - -destructor TDesignFormData.Destroy; -var - LImage: TImage; -begin - FForm.Form.WindowProc := FWndMethod; // ! important risky point :P - if FFormImages <> nil then - begin - for LImage in FFormImages do - LImage.Free; - FreeAndNil(FFormImages); - end; - FLastScreenshot.Free; - - inherited Destroy; - Pointer(FForm) := nil; -end; - -{ TModulePageControl } - -procedure TModulePageControl.SetDesignFormData(const AValue: TDesignFormData); -begin - if (AValue = FDesignFormData) then - // for show lfm code, if we want after editing lfm go back to form without any error - // (when we restart IDE some error can be raised ) - if (FResizer=Nil) - or ((AValue <> nil) and (FResizer.DesignedForm = AValue as IDesignedForm)) then - Exit; - - FDesignFormData := AValue; - if AValue = nil then - begin - //find - if Assigned(FResizer) then - FResizer.DesignedForm := nil; - end - else - begin - AValue.Form.LastActiveSourceWindow := Owner as TSourceEditorWindowInterface; - if Assigned(FResizer) then - FResizer.DesignedForm := AValue; - BoundToDesignTabSheet; - end; -end; - -destructor TModulePageControl.Destroy; -begin - DesignFormData := nil; - inherited Destroy; -end; - -procedure TModulePageControl.ShowDesignPage; -begin - Pages[1].TabVisible := True; -end; - -procedure TModulePageControl.HideDesignPage; -begin - Pages[1].TabVisible := False; -end; - -procedure TModulePageControl.BoundToDesignTabSheet; -begin - if (ActivePageIndex <> 1) then - Exit; - if Assigned(FResizer) then - FResizer.TryBoundSizerToDesignedForm(nil); -end; - -{ TSourceEditorWindowData } - -procedure TSourceEditorWindowData.SetActiveDesignFormData( - const AValue: TDesignFormData); -var - LPageCtrl: TModulePageControl; -begin - if FActiveDesignFormData = AValue then - Exit; - if FActiveDesignFormData <> nil then - // don't hide now if soon form will be hidden (for example on the IDE start) - if not FActiveDesignFormData.FHiding then - FActiveDesignFormData.FForm.HideWindow; - FActiveDesignFormData := AValue; - - LPageCtrl := FindModulePageControl(FForm); - if (AValue <> nil) then - begin - {with AValue as IDesignedForm do - if not AValue.FHiding and (RealBorderStyle <> bsNone) then - begin - //BeginUpdate; - //RealBorderIcons := []; - //RealBorderStyle := bsNone; - //Form.Show; - //EndUpdate; - end;} - // important when we want back to tab where was oppened form :< - LazarusIDE.DoShowDesignerFormOfSrc(FForm.ActiveEditor); - end; - - // when is fired DestroyEditor - from this place we can't navigate to pagecontrol by FForm (we need to handle lastactiveeditor) - if LPageCtrl = nil then - Exit; - LPageCtrl.DesignFormData := AValue; - // for USE_POPUP_PARENT_DESIGNER to eliminate form over code << maybe not needed any more since USE_POPUP_PARENT_DESIGNER isn't supported any more - LPageCtrl.OnChange(LPageCtrl); -end; - -constructor TSourceEditorWindowData.Create(AForm: TSourceEditorWindowInterface); -begin - FForm := AForm; - FPageCtrlList := TDictionary.Create; -end; - -destructor TSourceEditorWindowData.Destroy; -begin - FPageCtrlList.Free; - inherited Destroy; -end; - -procedure TSourceEditorWindowData.BoundToDesignTabSheet; -var - LPageCtrl: TModulePageControl; -begin - LPageCtrl := FindModulePageControl(FForm); - if LPageCtrl <> nil then - LPageCtrl.BoundToDesignTabSheet; -end; - -procedure TSourceEditorWindowData.OnChangeBounds(Sender: TObject); -//var -// LPageCtrl: TModulePageControl; -begin -// LPageCtrl := FindModulePageControl(FForm); -// if LPageCtrl <> nil then -// LPageCtrl.BoundToDesignTabSheet; -end; - -procedure TSourceEditorWindowData.AddPageCtrl(ASrcEditor: TSourceEditorInterface; APage: TModulePageControl); -begin - FPageCtrlList.Add(ASrcEditor, APage); - APage.Pages[1].OnChangeBounds:=OnChangeBounds; -end; - -procedure TSourceEditorWindowData.RemovePageCtrl(ASrcEditor: TSourceEditorInterface); -begin - FPageCtrlList.Remove(ASrcEditor); -end; - -{ TDTXTabMaster } - -function TDTXTabMaster.GetTabDisplayState: TTabDisplayState; -begin - Result := GetTabDisplayStateEditor(SourceEditorManagerIntf.ActiveEditor); -end; - -function TDTXTabMaster.GetTabDisplayStateEditor(Index: TSourceEditorInterface - ): TTabDisplayState; -var - LPageCtrl: TModulePageControl; -begin - if Index = nil then - Exit(tdsNone); - LPageCtrl := FindModulePageControl(Index); - if LPageCtrl = nil then - Exit(tdsNone); - case LPageCtrl.PageIndex of - 0: Exit(tdsCode); - 1: Exit(tdsDesign); - else - Exit(tdsOther); - end; -end; - -constructor TDTXTabMaster.Create; -begin - FAutoSizeControlList := TObjectList.Create(False); -end; - -destructor TDTXTabMaster.Destroy; -begin - FAutoSizeControlList.Free; - inherited Destroy; -end; - -function TDTXTabMaster.AutoSizeInShowDesigner(AControl: TControl): Boolean; -begin - FAutoSizeControlList.Add(AControl); - Result := True; -end; - -procedure TDTXTabMaster.EnableAutoSizing(AControl: TControl); -var - AIndex: Integer; - AutoSizeControl: TControl; -begin - if not Assigned(AControl) then Exit; - AutoSizeControl := nil; - - if AControl is TNonFormProxyDesignerForm then - begin - if (TNonFormProxyDesignerForm(AControl).LookupRoot is TControl) then - AutoSizeControl := TControl(TNonFormProxyDesignerForm(AControl).LookupRoot); - end - else - AutoSizeControl := AControl; - - AIndex := FAutoSizeControlList.IndexOf(AutoSizeControl); - if (AIndex >= 0) then - begin - FAutoSizeControlList.Delete(AIndex); - AutoSizeControl.EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorDockMaster Delayed'){$ENDIF}; - end; -end; - -procedure TDTXTabMaster.ToggleFormUnit; -begin - case TabDisplayState of - tdsCode: - ShowDesigner(SourceEditorManagerIntf.ActiveEditor); - tdsDesign: - ShowCode(SourceEditorManagerIntf.ActiveEditor); - end; -end; - -procedure TDTXTabMaster.JumpToCompilerMessage( - ASourceEditor: TSourceEditorInterface); -begin - SourceEditorManagerIntf.ActiveEditor := ASourceEditor; - ShowCode(ASourceEditor); -end; - -procedure TDTXTabMaster.ShowCode(ASourceEditor: TSourceEditorInterface); -begin - if ASourceEditor = nil then - Exit; - FindModulePageControl(ASourceEditor).PageIndex := 0; -end; - -procedure TDTXTabMaster.ShowDesigner(ASourceEditor: TSourceEditorInterface; AIndex: Integer); -var - LPageCtrl: TModulePageControl; -begin - if ASourceEditor = nil then - Exit; - LPageCtrl := FindModulePageControl(ASourceEditor); - if not LPageCtrl.Pages[1].TabVisible then - Exit; - LPageCtrl.PageIndex := 1; - LPageCtrl.OnChange(LPageCtrl); -end; - -procedure TDTXTabMaster.ShowForm(AForm: TCustomForm); -var - LEditor: TSourceEditorInterface; -begin - LEditor := FindSourceEditorForDesigner(AForm.Designer); - SourceEditorManagerIntf.ActiveEditor := LEditor; - ShowDesigner(LEditor); -end; - -{ TDTXComponentsMaster } - -function TDTXComponentsMaster.DrawNonVisualComponents(ALookupRoot: TComponent): Boolean; -var - LFormData: TDesignFormData; - LPageCtrl: TModulePageControl; -begin - Result := True; - LFormData := FindDesignFormData(FormEditingHook.GetDesignerForm(ALookupRoot){ALookupRoot as TCustomForm}); - if LFormData = nil then - Exit; - LPageCtrl := FindModulePageControl(LFormData.Form.LastActiveSourceWindow); - if (LPageCtrl = nil) or (LPageCtrl.Resizer = nil) or (LPageCtrl.Resizer.MainDTU = nil) then - Exit; - Result := LPageCtrl.Resizer.MainDTU.ShowNonVisualComponents; -end; - -{ TSpartaMainIDE } - -class procedure TSpartaMainIDE.Screen_FormAdded(Sender: TObject; Form: TCustomForm); -var - LSourceEditor: TSourceEditorInterface; - LFormData: TDesignFormData; - //i: Integer; - LPageCtrl: TModulePageControl; -begin - if IsFormDesign(Form) then - begin - // Form like TForm1 etc... - if (csDesignInstance in Form.ComponentState) or (Form is TNonFormProxyDesignerForm) then - begin - LFormData := TDesignFormData.Create(Form); - LFormData.FHiding:=True; - dsgnForms.Add(LFormData); - LSourceEditor := FindSourceEditorForDesigner(Form.Designer); - if LSourceEditor <> nil then - begin - LPageCtrl := FindModulePageControl(LSourceEditor); - if LPageCtrl <> nil then - begin - LPageCtrl.ShowDesignPage; - LPageCtrl.DesignFormData := LFormData; - end; - end; - SetTimer(Form.Handle, WM_SETNOFRAME, 10, nil); - end; - end - else - begin - // ONDREJ: the following code marged with (on-del) seems to help with nothing - // but slows down loading forms and make them flicker. - // I therefore commented it out. Please revert if there'll be regressions. - { // (on-del) - if not BoundInitialized then - begin - for i := 0 to Screen.FormCount - 1 do - if Screen.Forms[i] = Form then - Continue - else - begin - Screen.Forms[i].AddHandlerOnChangeBounds(GlobalOnChangeBounds); - end; - BoundInitialized := True; - end;} - - if Form is TSourceEditorWindowInterface then - begin - Form.AddHandlerOnChangeBounds(GlobalSNOnChangeBounds); - //Form.PopupMode := pmExplicit; // (on-del) - normForms.Add(Form); // (on-del) - end - else - begin - //Form.AddHandlerOnChangeBounds(GlobalOnChangeBounds); // (on-del) - end; - //Forms.Add(Form); // (on-del) - end; -end; - -class procedure TSpartaMainIDE.TryFreeFormData(Form: TCustomForm); -var - LSEWD: TSourceEditorWindowData; - mpc: TModulePageControl; - LFormData: TDesignFormData; -begin - Form.Parent := nil; - Application.ProcessMessages; // For TFrame - System Error. Code: 1400. Invalid window handle. - - LFormData := FindDesignFormData(Form); - dsgnForms.Remove(LFormData); - - for LSEWD in SourceEditorWindows.Values do - begin - if LSEWD.ActiveDesignFormData <> nil then - if LSEWD.ActiveDesignFormData.Form.Form = Form then - LSEWD.FActiveDesignFormData := nil; // important - we can't call OnChange tab, because tab don't exist anymore - - for mpc in LSEWD.FPageCtrlList.Values do - if mpc.DesignFormData <> nil then - if mpc.DesignFormData.Form.Form = Form then - mpc.DesignFormData := nil; - end; - LFormData.Free; -end; - -class procedure TSpartaMainIDE.Screen_FormDel(Sender: TObject; Form: TCustomForm); -begin - if not IsFormDesign(Form) then - begin - if Form is TSourceEditorWindowInterface then - Form.RemoveHandlerOnChangeBounds(GlobalSNOnChangeBounds) - else - Form.RemoveHandlerOnChangeBounds(GlobalOnChangeBounds) - end - else - TryFreeFormData(Form); -end; - -class procedure TSpartaMainIDE.WindowCreate(Sender: TObject); -var - LSourceEditorWindow: TSourceEditorWindowInterface; -begin - if Sender.ClassNameIs('TSourceNotebook') then - begin - LSourceEditorWindow := Sender as TSourceEditorWindowInterface; - SourceEditorWindows.Add(LSourceEditorWindow, TSourceEditorWindowData.Create(LSourceEditorWindow)); - end; -end; - -class procedure TSpartaMainIDE.WindowDestroy(Sender: TObject); -var - p: Pointer; - f: TDesignFormData absolute p; -begin - for p in dsgnForms do - if f.FForm.LastActiveSourceWindow = Sender then - f.FForm.LastActiveSourceWindow := nil; - SourceEditorWindows.Remove(Sender as TSourceEditorWindowInterface); - if LastActiveSourceEditorWindow = Sender then - LastActiveSourceEditorWindow := nil; -end; - -class procedure TSpartaMainIDE.WindowShow(Sender: TObject); -var - LWindow: TSourceEditorWindowInterface; - LWindowData: TSourceEditorWindowData; - LDesignedForm: IDesignedForm; -begin - LWindow := Sender as TSourceEditorWindowInterface; - if not SourceEditorWindows.TryGetValue(LWindow, LWindowData) or - (LWindowData.ActiveDesignFormData = nil) - then - Exit; - LDesignedForm := LWindowData.ActiveDesignFormData as IDesignedForm; - LDesignedForm.ShowWindow; -end; - -class procedure TSpartaMainIDE.WindowHide(Sender: TObject); -var - LWindow: TSourceEditorWindowInterface; - LWindowData: TSourceEditorWindowData; - LDesignedForm: IDesignedForm; -begin - LWindow := Sender as TSourceEditorWindowInterface; - if not SourceEditorWindows.TryGetValue(LWindow, LWindowData) or - (LWindowData.ActiveDesignFormData = nil) - then - Exit; - LDesignedForm := LWindowData.ActiveDesignFormData as IDesignedForm; - LDesignedForm.HideWindow; -end; - -class procedure TSpartaMainIDE.DesignerSetFocus; -var - LResizer: TResizer; -begin - LResizer := GetCurrentResizer; - if LResizer<>nil then - LResizer.ActiveResizeFrame.DesignerSetFocus; -end; - -class procedure TSpartaMainIDE.EditorActivated(Sender: TObject); -var - LDesigner: TIDesigner; - LSourceEditor: TSourceEditorInterface; - - function LastSourceEditorNotFound: boolean; - var - i: Integer; - se: TSourceEditorInterface; - ASourceEditorWindowData: TSourceEditorWindowData; - begin - if (LastActiveSourceEditorWindow = nil) or (LastActiveSourceEditor = nil) then - Exit(False); - - ASourceEditorWindowData := SourceEditorWindows[LastActiveSourceEditorWindow]; - for se in ASourceEditorWindowData.FPageCtrlList.Keys do - begin - Result := True; - for i := 0 to LastActiveSourceEditorWindow.Count - 1 do - if se = LastActiveSourceEditorWindow.Items[i] then - begin - Result := False; - Break; - end; - if Result then - begin - LastActiveSourceEditor := se; // after moving code editor into other window, sometimes IDE switch to other tab :\ damn... this line prevent this. - Exit; - end; - end; - Result := False; - end; - -var - LPageCtrl: TModulePageControl; - LSourceEditorWindow: TSourceEditorWindowInterface; - LDesignFormData: TDesignFormData; -begin - if Sender is TSourceEditorInterface then - begin - LSourceEditor := TSourceEditorInterface(Sender); - // if we create directly new project then Activate is called without EditorCreate... - if not (LSourceEditor.EditorControl.Parent.Parent is TModulePageControl) then - begin - // possible is situation when we moved tab into other window - // then was not called event EditorDestroy - that generates problems with switching tabs - // or when we moving tab to first window ( then is raising : duplicates not allowed in dictionary). - if LastSourceEditorNotFound then - EditorDestroyed(nil); - EditorCreate(Sender); - end; - LDesigner := LSourceEditor.GetDesigner(True); - // should be performed during EditorCreate (parent of parent is module page ctrl) - LPageCtrl := TModulePageControl(LSourceEditor.EditorControl.Parent.Parent); - if LPageCtrl = nil then - Exit; - if LDesigner = nil then - LPageCtrl.HideDesignPage - else - begin - if LPageCtrl.Resizer = nil then - LPageCtrl.FResizer := TResizer.Create(LPageCtrl.Pages[1], TResizerFrame); - LPageCtrl.ShowDesignPage; - end; - - LSourceEditorWindow := TSourceEditorWindowInterface(LPageCtrl.Owner); - LastActiveSourceEditorWindow := LSourceEditorWindow; - LastActiveSourceEditor := LSourceEditor; - LDesignFormData := FindDesignFormData(LPageCtrl); - // when we switch tab, design form should be hidden - if (LDesigner = nil) or (LDesignFormData = nil) then - SourceEditorWindows[LSourceEditorWindow].ActiveDesignFormData := nil - else - begin - // during form loading for example from package, ActiveDesignFormData assignment, - // blocks the message queue responsible for hiding form - // We can't check it because there are some forms where designing is not handled yet. - // (for that kind of forms is returned empty designformdata) - // maybe we can fix this in future - if not LDesignFormData.FHiding then - // Prevent unexpected events (when is deactivated some control outside designed form) - if (LDesignFormData.Form.LastActiveSourceWindow = LSourceEditorWindow) - // important!!! for many error - switching between editors... - and (LPageCtrl.PageIndex = 1) then - SourceEditorWindows[LSourceEditorWindow].ActiveDesignFormData := LDesignFormData - else - SourceEditorWindows[LSourceEditorWindow].ActiveDesignFormData := nil; - end; - - case LPageCtrl.PageIndex of - 0: if LDesignFormData <> nil then LDesignFormData.Form.HideWindow; - 1: - begin - // Michl: I comment the next line, as it breaks other editors - // (like Actionlist Editor). Imho in all cases all designer - // were already active, so it isn't needed. See issue #33872 - // LazarusIDE.DoShowDesignerFormOfSrc(LSourceEditorWindow.ActiveEditor); - - // for lfm edition... - with LDesignFormData as IDesignedForm do - if not LDesignFormData.FHiding {and (RealBorderStyle <> bsNone)} then - begin - //BeginUpdate; - //RealBorderIcons := []; - //RealBorderStyle := bsNone; - //Form.Show; - //EndUpdate; - LPageCtrl.BoundToDesignTabSheet; - SetTimer(Form.Handle, WM_BOUNDTODESIGNTABSHEET, 10, nil); - end; - end; - end; - end - else - RefreshAllSourceWindowsModulePageControl; -end; - -class procedure TSpartaMainIDE.EditorDestroyed(Sender: TObject); -var - LSourceEditor: TSourceEditorInterface; - LPageCtrl: TModulePageControl; - LSourceEditorWindow: TSourceEditorWindowInterface; - LSourceEditorWindowData: TSourceEditorWindowData; - LFormData: TDesignFormData; -begin - // sender is here as special parameter, because is possible situation where is moved editor - // to another window and was not triggered EditorDestroy - for more info goto editoractivate - if Sender = nil then - LSourceEditor := LastActiveSourceEditor - else - LSourceEditor := TSourceEditorInterface(Sender); - - // parent don't exist anymore and we must search in each window... - if Sender = nil then // but not for Sender = nil :P - begin - LSourceEditorWindowData := SourceEditorWindows[LastActiveSourceEditorWindow]; - LPageCtrl := LSourceEditorWindowData.FPageCtrlList[LastActiveSourceEditor] - end else - LPageCtrl := AbsoluteFindModulePageControl(LSourceEditor); - - if LPageCtrl = nil then - Exit; - - LFormData := FindDesignFormData(LSourceEditor.GetDesigner(False)); - - // goto first comment (forced destroy) - if Sender = nil then - LSourceEditorWindow := LastActiveSourceEditorWindow - else - LSourceEditorWindow := TSourceEditorWindowInterface(LPageCtrl.Owner); - - if LFormData <> nil then - begin - SourceEditorWindows[LSourceEditorWindow].ActiveDesignFormData := nil; - LFormData.Form.LastActiveSourceWindow := nil; - end; - - SourceEditorWindows[LSourceEditorWindow].RemovePageCtrl(LSourceEditor); - LPageCtrl.Free; - - if LastActiveSourceEditor = LSourceEditor then - LastActiveSourceEditor := nil; -end; - -class function TSpartaMainIDE.GetCurrentResizer: TResizer; -var - LForm: TCustomForm; - LFormData: TDesignFormData; - LSourceWindow: TSourceEditorWindowInterface; - LPageCtrl: TModulePageControl; -begin - Result := nil; - if (FormEditingHook = nil) or (GlobalDesignHook = nil) then - Exit; - LForm := FormEditingHook.GetDesignerForm(GlobalDesignHook.LookupRoot); - LFormData := FindDesignFormData(LForm); - if LFormData=nil then Exit; - LSourceWindow := (LFormData as IDesignedFormIDE).LastActiveSourceWindow; - LPageCtrl := FindModulePageControl(LSourceWindow); - Result := LPageCtrl.Resizer; -end; - -class procedure TSpartaMainIDE.EditorCreate(Sender: TObject); - -var - LSourceEditor: TSourceEditorInterface; - - function CreateModulePageControl: TModulePageControl; - var - LNewTabSheet: TTabSheet; - LSourceEditorWindow: TSourceEditorWindowInterface; - LParent: TWinControl; - begin - Result := TModulePageControl.Create(LSourceEditor.EditorControl.Owner); - Result.TabPosition := tpBottom; - Result.Align:=alClient; - LParent := LSourceEditor.EditorControl.Parent; - - LNewTabSheet := TTabSheet.Create(Result); - LNewTabSheet.PageControl := Result; - LNewTabSheet.Caption := SCode; - LSourceEditor.EditorControl.Parent := LNewTabSheet; // ! SynEdit :) - - LNewTabSheet := TTabSheet.Create(Result); - LNewTabSheet.PageControl := Result; - LNewTabSheet.Caption := SDesigner; - - Result.OnChange := TabChange; - Result.Parent := LParent; - LSourceEditorWindow := TSourceEditorWindowInterface(Result.Owner); - SourceEditorWindows[LSourceEditorWindow].AddPageCtrl(LSourceEditor, Result) - end; - -begin - LSourceEditor := Sender as TSourceEditorInterface; - if not (LSourceEditor.EditorControl.Parent.Parent is TModulePageControl) then - CreateModulePageControl; -end; - -class procedure TSpartaMainIDE.TabChange(Sender: TObject); -var - LActiveSourceWindow: TSourceEditorWindowInterface; - w: TSourceEditorWindowInterface; - p: TPair; - LDesigner: TIDesigner; - LFormData: TDesignFormData; - LPageCtrl: TModulePageControl; - LSourceWndData: TSourceEditorWindowData; -begin - // activate proper source editor window when user is clicking on page. - // (at clicking time can be active other source window) - LActiveSourceWindow := TComponent(Sender).Owner as TSourceEditorWindowInterface; - if LActiveSourceWindow <> SourceEditorManagerIntf.ActiveSourceWindow then - SourceEditorManagerIntf.ActiveSourceWindow := LActiveSourceWindow; - - LPageCtrl := TModulePageControl(Sender); - // in case there is no module and is visible page other than code page. - if (LActiveSourceWindow.ActiveEditor <> nil) and (LPageCtrl <> nil) then - begin - LDesigner := LActiveSourceWindow.ActiveEditor.GetDesigner(True); - LFormData := FindDesignFormData(LDesigner); - if (LFormData <> nil) - and SourceEditorWindows.TryGetValue(LActiveSourceWindow, LSourceWndData) then - begin - case LPageCtrl.ActivePageIndex of - 0: LSourceWndData.ActiveDesignFormData := nil; - 1: begin // deactivate design tab in other page control :) - for w in SourceEditorWindows.Keys do - if w = LActiveSourceWindow then - Continue - else - for p in SourceEditorWindows[w].FPageCtrlList do - if (p.Value.DesignFormData = LFormData) and (p.Value <> Sender) then - IDETabMaster.ShowCode(p.Key); - LSourceWndData.ActiveDesignFormData := LFormData; - // enable autosizing after creating a new form - TDTXTabMaster(IDETabMaster).EnableAutoSizing(LFormData.Form.Form); - // to handle windows with different size - LPageCtrl.BoundToDesignTabSheet; - end; - end; - end; - end; -end; - -class procedure TSpartaMainIDE.GlobalOnChangeBounds(Sender: TObject); -var - sewd: TSourceEditorWindowData; -begin - for sewd in SourceEditorWindows.Values do - sewd.OnChangeBounds(Sender); -end; - -class procedure TSpartaMainIDE.GlobalSNOnChangeBounds(Sender: TObject); -var - LWindow: TSourceEditorWindowInterface; - LWindowData: TSourceEditorWindowData; - LDesignForm: TDesignFormData; -begin - // Check parent. Maybe is different? If yes then window changed state (docked/undocked) and we need to perform few actions - LWindow := Sender as TSourceEditorWindowInterface; - - // dock/undock event :) - if not SourceEditorWindows.TryGetValue(LWindow, LWindowData) then - Exit; - if LWindowData.FLastTopParent <> LWindow.GetTopParent then - begin - LWindowData.FLastTopParent := LWindow.GetTopParent; - // refresh for popupparent - LDesignForm := LWindowData.ActiveDesignFormData; - LWindowData.ActiveDesignFormData := nil; - LWindowData.ActiveDesignFormData := LDesignForm; - if LDesignForm <> nil then - begin - LDesignForm.Form.Form.Parent := FindModulePageControl(LWindow).Resizer.ActiveResizeFrame.FormHandler; - SetTimer(LDesignForm.Form.Form.Handle, WM_BOUNDTODESIGNTABSHEET, 10, nil); - end; - end; - - LWindowData.OnChangeBounds(Sender); -end; - -class procedure TSpartaMainIDE.OnDesignMouseDown(Sender: TObject; - Button: TMouseButton; Shift: TShiftState; X, Y: Integer); -begin - DesignerSetFocus; -end; - -class procedure TSpartaMainIDE.OnModifiedSender(Sender: TObject); -begin - OnModified(Nil); -end; - -class procedure TSpartaMainIDE.OnModified(APersistent: TPersistent); -var - LResizer: TResizer; -begin - LResizer := GetCurrentResizer; - if LResizer<>nil then - LResizer.ActiveResizeFrame.OnModified; -end; - -class procedure TSpartaMainIDE.OnModifiedPersistentAdded( - APersistent: TPersistent; Select: Boolean); -begin - OnModified(Nil); -end; - -class procedure TSpartaMainIDE.OnShowDesignerForm(Sender: TObject; AEditor: TSourceEditorInterface; - AComponentPaletteClassSelected: Boolean); -var - LForm: TDesignFormData; - LPageCtrl, p: TModulePageControl; - w: TSourceEditorWindowInterface; - e: TSourceEditorInterface; -begin - LForm := FindDesignFormData(TCustomForm(Sender).Designer); - if (LForm = nil) or LForm.FHiding then - Exit; - LPageCtrl := FindModulePageControl(SourceEditorManagerIntf.ActiveEditor); - if LPageCtrl = nil then - Exit; // it should not happen but who knows :P Lazarus IDE is sometimes mischievous - - if AComponentPaletteClassSelected then - begin - // if form is already opened do nothing, if not then show form for active module. - for w in SourceEditorWindows.Keys do - begin - e := w.ActiveEditor; - if (e = nil) or (e.GetDesigner(True) <> LForm.Form.Form.Designer) then - Continue; - p := FindModulePageControl(e); - if p.PageIndex = 1 then - Exit; - end; - end; - IDETabMaster.ShowDesigner(SourceEditorManagerIntf.ActiveEditor); -end; - -class procedure TSpartaMainIDE.OnShowSrcEditor(Sender: TObject); -begin - IDETabMaster.ShowCode(Sender as TSourceEditorInterface); -end; - -class procedure TSpartaMainIDE.OnShowMethod(const Name: String); -var - LForm: TDesignFormData; - LSecondEditor: TSourceEditorInterface = nil; - i: Integer; - LSourceWindow: TSourceEditorWindowInterface; -begin - if FormEditingHook = nil then - Exit; - LForm := FindDesignFormData(FormEditingHook.GetCurrentDesigner); - if LForm = nil then - Exit; - for i := 0 to SourceEditorManagerIntf.SourceWindowCount - 1 do - begin - LSourceWindow := SourceEditorManagerIntf.SourceWindows[i]; - if LForm.Form.LastActiveSourceWindow = LSourceWindow then - Continue; - if LSourceWindow.ActiveEditor <> nil then - if LSourceWindow.ActiveEditor.GetDesigner(True) = LForm.Form.Form.Designer then - begin - LSecondEditor := LSourceWindow.ActiveEditor; - Break; - end; - end; - - if Assigned(LSecondEditor) then - begin - IDETabMaster.ShowCode(LSecondEditor); - LazarusIDE.DoShowMethod(LSecondEditor, Name); - end - else - if Assigned(LForm.Form.LastActiveSourceWindow) then - IDETabMaster.ShowCode(LForm.Form.LastActiveSourceWindow.ActiveEditor); -end; - -class procedure TSpartaMainIDE.OnDesignRefreshPropertyValues; -var - LForm: TCustomForm; - LSourceWindow: TSourceEditorWindowInterface; - LFormData: TDesignFormData; - LPageCtrl: TModulePageControl; - - function RootIsSelected: Boolean; - var - LSelection: TPersistentSelectionList; - i: integer; - begin - Result := False; - LSelection := TPersistentSelectionList.Create; - GlobalDesignHook.GetSelection(LSelection); - for i := 0 to LSelection.Count - 1 do - if LSelection.Items[i] = GlobalDesignHook.LookupRoot then - begin - Result := True; - Break; - end; - LSelection.Free; - end; - -begin - if (GlobalDesignHook.LookupRoot is TCustomFrame) then - begin - if not RootIsSelected then - Exit; - LForm := FormEditingHook.GetDesignerForm(GlobalDesignHook.LookupRoot); - LFormData := FindDesignFormData(LForm); - LSourceWindow := (LFormData as IDesignedFormIDE).LastActiveSourceWindow; - LPageCtrl := FindModulePageControl(LSourceWindow); - TFakeFrame(LForm).SetBounds(LForm.Left-1,LForm.Top-1,TFakeFrame(LForm).Width,TFakeFrame(LForm).Height); - //LPageCtrl.BoundToDesignTabSheet; - end - else - if (GlobalDesignHook.LookupRoot is TCustomForm) then - begin - if not RootIsSelected then - Exit; - LForm := TCustomForm(GlobalDesignHook.LookupRoot); - LFormData := FindDesignFormData(LForm); - LSourceWindow := (LFormData as IDesignedFormIDE).LastActiveSourceWindow; - LPageCtrl := FindModulePageControl(LSourceWindow); - LPageCtrl.BoundToDesignTabSheet; - end; -end; - -initialization - dsgnForms := Classes.TList.Create; - SourceEditorWindows := TObjectDictionary.Create([doOwnsValues]); - normForms := Classes.TList.Create; - -finalization - normForms.Free; - SourceEditorWindows.Free; - FreeAndNil(dsgnForms); -end. - diff --git a/components/sparta/dockedformeditor/source/sparta_reg_dockedformeditor.pas b/components/sparta/dockedformeditor/source/sparta_reg_dockedformeditor.pas deleted file mode 100644 index bf5bedace0..0000000000 --- a/components/sparta/dockedformeditor/source/sparta_reg_dockedformeditor.pas +++ /dev/null @@ -1,73 +0,0 @@ -{ - ***************************************************************************** - See the file COPYING.modifiedLGPL.txt, included in this distribution, - for details about the license. - ***************************************************************************** - - Author: Maciej Izak - - DaThoX 2004-2015 - FreeSparta.com -} - -unit sparta_reg_DockedFormEditor; - -{$WARNING Package Sparta_DockedFormEditor is deprecated} -{$WARNING You can use DockedFormEditor instead} -{$mode delphi}{$H+} - -interface - -uses - SysUtils, - // LCL - LazIDEIntf, ComCtrls, Controls, Forms, Buttons, ExtCtrls, Graphics, EditBtn, - // IdeIntf - SrcEditorIntf, IDEWindowIntf, PropEdits, ComponentEditors, - // Sparta - sparta_MainIDE; - -procedure Register; - -implementation - -procedure Register; -begin - //FormEditingHook.StandardDesignerBaseClasses[DesignerBaseClassId_TForm] := TFakeForm; - //FormEditingHook.StandardDesignerBaseClasses[DesignerBaseClassId_TFrame] := THookFrame; - - //FormEditingHook.NonFormProxyDesignerForm[NonControlProxyDesignerFormId] := TFakeNonControl; - //FormEditingHook.NonFormProxyDesignerForm[FrameProxyDesignerFormId] := TFakeFrame; - - Screen.AddHandlerFormAdded(TSpartaMainIDE.Screen_FormAdded); - Screen.AddHandlerRemoveForm(TSpartaMainIDE.Screen_FormDel); - SourceEditorManagerIntf.RegisterChangeEvent(semWindowCreate, TSpartaMainIDE.WindowCreate); - SourceEditorManagerIntf.RegisterChangeEvent(semWindowDestroy, TSpartaMainIDE.WindowDestroy); - SourceEditorManagerIntf.RegisterChangeEvent(semWindowShow, TSpartaMainIDE.WindowShow); - SourceEditorManagerIntf.RegisterChangeEvent(semWindowHide, TSpartaMainIDE.WindowHide); - SourceEditorManagerIntf.RegisterChangeEvent(semEditorActivate, TSpartaMainIDE.EditorActivated); - SourceEditorManagerIntf.RegisterChangeEvent(semEditorDestroy, TSpartaMainIDE.EditorDestroyed); - SourceEditorManagerIntf.RegisterChangeEvent(semEditorCreate, TSpartaMainIDE.EditorCreate); - - LazarusIDE.AddHandlerOnShowDesignerFormOfSource(TSpartaMainIDE.OnShowDesignerForm); - LazarusIDE.AddHandlerOnShowSourceOfActiveDesignerForm(TSpartaMainIDE.OnShowSrcEditor); - - GlobalDesignHook.AddHandlerShowMethod(TSpartaMainIDE.OnShowMethod); - GlobalDesignHook.AddHandlerModified(TSpartaMainIDE.OnModifiedSender); - GlobalDesignHook.AddHandlerPersistentAdded(TSpartaMainIDE.OnModifiedPersistentAdded); - GlobalDesignHook.AddHandlerPersistentDeleted(TSpartaMainIDE.OnModified); - GlobalDesignHook.AddHandlerRefreshPropertyValues(TSpartaMainIDE.OnDesignRefreshPropertyValues); - GlobalDesignHook.AddHandlerDesignerMouseDown(TSpartaMainIDE.OnDesignMouseDown); - - IDETabMaster := TDTXTabMaster.Create; - IDEComponentsMaster := TDTXComponentsMaster.Create; -end; - -finalization - Screen.RemoveHandlerFormAdded(TSpartaMainIDE.Screen_FormAdded); - Screen.RemoveHandlerRemoveForm(TSpartaMainIDE.Screen_FormDel); - - IDETabMaster.Free; - IDEComponentsMaster.Free; -end. - diff --git a/components/sparta/dockedformeditor/source/sparta_resizer.pas b/components/sparta/dockedformeditor/source/sparta_resizer.pas deleted file mode 100644 index c37d8d0b59..0000000000 --- a/components/sparta/dockedformeditor/source/sparta_resizer.pas +++ /dev/null @@ -1,99 +0,0 @@ -{ - ***************************************************************************** - See the file COPYING.modifiedLGPL.txt, included in this distribution, - for details about the license. - ***************************************************************************** - - Author: Maciej Izak - - DaThoX 2004-2015 - FreeSparta.com -} - -unit sparta_Resizer; - -{$mode objfpc}{$H+} - -interface - -uses - Classes, SysUtils, - // LCL - Controls, - // IdeIntf - FormEditingIntf, - // Sparta - sparta_InterfacesMDI, SpartaAPI, sparta_BasicResizeFrame, sparta_BasicResizer; - -type - - { TResizer } - - TResizer = class(TBasicResizer, IResizer) - protected - FMainDTU: ISTAMainDesignTimeUtil; - FEDTU: TList; - - class var - FStarter, FProfessional: TNotifyEvent; - - procedure SetDesignedForm(const AValue: IDesignedForm); override; - public - property MainDTU: ISTAMainDesignTimeUtil read FMainDTU; - - constructor Create(AParent: TWinControl; AResizerFrameClass: TResizerFrameClass); override; - destructor Destroy; override; - end; - -implementation - -{ TResizer } - -procedure TResizer.SetDesignedForm(const AValue: IDesignedForm); -var - LLookupRoot: TComponent; -begin - inherited SetDesignedForm(AValue); - - if AValue <> nil then - begin - // in this place DesignedForm should be initialized by current editor (+ "sizer") - // TODO some interfaces for utils (Design Time Utils - DTU) ? - LLookupRoot := LookupRoot(DesignedForm.Form); - - if FMainDTU <> nil then - FMainDTU.Root := LLookupRoot; - end - else - begin - if FMainDTU <> nil then - FMainDTU.Root := nil; - end; -end; - -constructor TResizer.Create(AParent: TWinControl; - AResizerFrameClass: TResizerFrameClass); -begin - inherited Create(AParent, AResizerFrameClass); - - FEDTU := TList.Create; - - if DTUManager <> nil then - begin - FMainDTU := DTUManager.CreateMainDTU(pMainDTU, pAddons); - end; - - if Assigned(FStarter) then - FStarter(Self); -end; - -destructor TResizer.Destroy; -begin - FEDTU.Free; - Pointer(FMainDTU) := nil; // released by owner - - inherited Destroy; -end; - -end. - diff --git a/components/sparta/dockedformeditor/source/sparta_resizerframe.lfm b/components/sparta/dockedformeditor/source/sparta_resizerframe.lfm deleted file mode 100644 index 669db685db..0000000000 --- a/components/sparta/dockedformeditor/source/sparta_resizerframe.lfm +++ /dev/null @@ -1,16 +0,0 @@ -inherited ResizerFrame: TResizerFrame - inherited pR: TPanel - AnchorSideTop.Control = Owner - end - inherited pB: TPanel - AnchorSideLeft.Control = Owner - end - inherited pL: TPanel - AnchorSideLeft.Control = Owner - AnchorSideTop.Control = Owner - end - inherited pT: TPanel - AnchorSideLeft.Control = Owner - AnchorSideTop.Control = Owner - end -end diff --git a/components/sparta/dockedformeditor/source/sparta_resizerframe.pas b/components/sparta/dockedformeditor/source/sparta_resizerframe.pas deleted file mode 100644 index 05e2ee6f51..0000000000 --- a/components/sparta/dockedformeditor/source/sparta_resizerframe.pas +++ /dev/null @@ -1,96 +0,0 @@ -{ - ***************************************************************************** - See the file COPYING.modifiedLGPL.txt, included in this distribution, - for details about the license. - ***************************************************************************** - - Author: Maciej Izak - - DaThoX 2004-2015 - FreeSparta.com -} - -unit sparta_ResizerFrame; - -{$mode delphi}{$H+} - -interface - -uses - SysUtils, - // IdeIntf - FormEditingIntf, PropEdits, ObjectInspector, - // Sparta - sparta_BasicResizeFrame; - -type - - { TResizerFrame } - - TResizerFrame = class(TBasicResizeFrame) - private - FActivePropertyGridItemIndex: Integer; - protected - procedure TryBoundDesignedForm; override; - procedure BeginFormSizeUpdate(Sender: TObject); override; - procedure EndFormSizeUpdate(Sender: TObject); override; - end; - -implementation - -{$R *.lfm} - -{ TResizerFrame } - -procedure TResizerFrame.TryBoundDesignedForm; -begin - if DesignedForm = nil then - Exit; - - // special for frames - {DesignedForm.BeginUpdate; - DesignedForm.RealWidth := DesignedForm.RealWidth + 1; - DesignedForm.RealWidth := DesignedForm.RealWidth - 1; - DesignedForm.EndUpdate;} - - inherited TryBoundDesignedForm; -end; - -procedure TResizerFrame.BeginFormSizeUpdate(Sender: TObject); -var - OI: TObjectInspectorDlg; -begin - inherited; - - // when was active ActivePropertyGrid.ItemIndex for height or width during scaling - // there was problem with values :< - OI := FormEditingHook.GetCurrentObjectInspector; - if ((Sender = pR) or (Sender = pB) or (FNodes.IndexOf(Sender) in [3,4,5])) and Assigned(OI) then - begin - FActivePropertyGridItemIndex := OI.GetActivePropertyGrid.ItemIndex; - OI.GetActivePropertyGrid.ItemIndex := -1; - end - else - FActivePropertyGridItemIndex := -1; -end; - -procedure TResizerFrame.EndFormSizeUpdate(Sender: TObject); -var - OI: TObjectInspectorDlg; -begin - inherited; - - // restore last selected item in OI. - if FActivePropertyGridItemIndex <> -1 then - begin - OI := FormEditingHook.GetCurrentObjectInspector; - if OI <> nil then - OI.GetActivePropertyGrid.ItemIndex := FActivePropertyGridItemIndex; - FActivePropertyGridItemIndex := -1; - end; - - GlobalDesignHook.RefreshPropertyValues; -end; - -end. - diff --git a/components/sparta/dockedformeditor/source/spartaapi.pas b/components/sparta/dockedformeditor/source/spartaapi.pas deleted file mode 100644 index 9c4fbe5459..0000000000 --- a/components/sparta/dockedformeditor/source/spartaapi.pas +++ /dev/null @@ -1,117 +0,0 @@ -{ - ***************************************************************************** - See the file COPYING.modifiedLGPL.txt, included in this distribution, - for details about the license. - ***************************************************************************** - - Author: Maciej Izak - - DaThoX 2004-2015 - FreeSparta.com -} - -unit SpartaAPI; - -{$mode objfpc}{$H+} - -interface - -uses - Classes, Controls; - -type - ISTADesignTimeUtil = interface - ['{E135BF89-AFA9-402A-9663-4F1536C7717A}'] - function GetRoot: TPersistent; - procedure SetRoot(ARoot: TPersistent); - - property Root: TPersistent read GetRoot write SetRoot; - end; - - // Sparta Tools API - ISTAMainDesignTimeUtil = interface(ISTADesignTimeUtil) - ['{53491607-D285-4050-9064-C764EB8E59B9}'] - function GetShowNonVisualComponents: Boolean; - property ShowNonVisualComponents: Boolean read GetShowNonVisualComponents; - end; - - ISTANonVisualComponentsUtil = interface(ISTADesignTimeUtil) - ['{A181688F-572E-4724-AAF1-575B979A1EC2}'] - function GetShowNonVisualComponents: Boolean; - property ShowNonVisualComponents: Boolean read GetShowNonVisualComponents; - end; - - ISTAExtendedDesignTimeUtil = interface(ISTADesignTimeUtil) - ['{1F484121-2295-4847-BFD9-A77C643EA3A7}'] - // TODO OnShow - // TODO OnHide - // TODO UpdateRoot - // TODO FreeOnStrongHide...? free mem for some utils - procedure RefreshValues; - - procedure SetParent(AWinCtrl: TWinControl); - function GetParent: TWinControl; - procedure SetVisible(AValue: Boolean); - function GetVisible: Boolean; - - property Visible: Boolean read GetVisible write SetVisible; - property Parent: TWinControl read GetParent write SetParent; - end; - - TSTADesignTimeUtil = class - - end; - - TSTADesignTimeUtilClass = class of TSTADesignTimeUtil; - - TEDTU = class - public - class function AvailableForRoot(ARoot: TPersistent): Boolean; virtual; abstract; - class function CreateEDTUForRoot(TheOwner: TComponent; ARoot: TPersistent): ISTAExtendedDesignTimeUtil; virtual; abstract; - class function GlyphName: string; virtual; abstract; - end; - - TEDTUClass = class of TEDTU; - - { TSTADesignTimeUtilsManager } - - TSTADesignTimeUtilsManager = class - protected - function GetEDTUCount: Integer; virtual; - function GetEDTU(Index: Integer): TEDTUClass; virtual; abstract; - public - function CreateMainDTU({%H-}AParent, {%H-}AAddons: TWinControl): ISTAMainDesignTimeUtil; virtual; - procedure RegisterEDTU({%H-}AEDTUClass: TEDTUClass); virtual; - procedure UnregisterEDTU({%H-}AEDTUClass: TEDTUClass); virtual; - property EDTUCount: Integer read GetEDTUCount; - property EDTU[Index: Integer]: TEDTUClass read GetEDTU; - end; - -var - DTUManager: TSTADesignTimeUtilsManager = nil; - -implementation - -{ TSTADesignTimeUtilsManager } - -function TSTADesignTimeUtilsManager.GetEDTUCount: Integer; -begin - Result := 0; -end; - -function TSTADesignTimeUtilsManager.CreateMainDTU(AParent, AAddons: TWinControl - ): ISTAMainDesignTimeUtil; -begin - Result := nil; -end; - -procedure TSTADesignTimeUtilsManager.RegisterEDTU(AEDTUClass: TEDTUClass); -begin -end; - -procedure TSTADesignTimeUtilsManager.UnregisterEDTU(AEDTUClass: TEDTUClass); -begin -end; - -end. - diff --git a/components/sparta/dockedformeditor/sparta_dockedformeditor.lpk b/components/sparta/dockedformeditor/sparta_dockedformeditor.lpk deleted file mode 100644 index 6b80c2dc3b..0000000000 --- a/components/sparta/dockedformeditor/sparta_dockedformeditor.lpk +++ /dev/null @@ -1,92 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/components/sparta/dockedformeditor/sparta_dockedformeditor.pas b/components/sparta/dockedformeditor/sparta_dockedformeditor.pas deleted file mode 100644 index bb3e006989..0000000000 --- a/components/sparta/dockedformeditor/sparta_dockedformeditor.pas +++ /dev/null @@ -1,26 +0,0 @@ -{ This file was automatically created by Lazarus. Do not edit! - This source is only used to compile and install the package. - } - -unit sparta_DockedFormEditor; - -{$warn 5023 off : no warning about unused units} -interface - -uses - sparta_reg_DockedFormEditor, sparta_DesignedForm, sparta_Resizer, - sparta_ResizerFrame, SpartaAPI, sparta_FakeCustom, sparta_FakeForm, - sparta_FakeFrame, sparta_FakeNonControl, sparta_MainIDE, sparta_strconsts, - LazarusPackageIntf; - -implementation - -procedure Register; -begin - RegisterUnit('sparta_reg_DockedFormEditor', - @sparta_reg_DockedFormEditor.Register); -end; - -initialization - RegisterPackage('sparta_DockedFormEditor', @Register); -end. diff --git a/components/sparta/dockedformeditor/sparta_strconsts.pas b/components/sparta/dockedformeditor/sparta_strconsts.pas deleted file mode 100644 index 3986bb8cb0..0000000000 --- a/components/sparta/dockedformeditor/sparta_strconsts.pas +++ /dev/null @@ -1,14 +0,0 @@ -unit sparta_strconsts; - -{$mode objfpc}{$H+} - -interface - -resourcestring - SCode = 'Code'; - SDesigner = 'Designer'; - -implementation - -end. - diff --git a/components/sparta/mdi/source/sparta_abstractresizer.pas b/components/sparta/mdi/source/sparta_abstractresizer.pas deleted file mode 100644 index 909d53fb8b..0000000000 --- a/components/sparta/mdi/source/sparta_abstractresizer.pas +++ /dev/null @@ -1,384 +0,0 @@ -unit sparta_AbstractResizer; - -{$mode delphi}{$H+} - -interface - -uses - Classes, SysUtils, Math, - LCLType, Controls, ExtCtrls, Forms, StdCtrls, Buttons, Dialogs, - sparta_InterfacesMDI, sparta_BasicResizeFrame, sparta_MDI_StrConsts; - -type - - { TAbstractResizer } - - TAbstractResizer = class(TComponent, IResizer) - protected { IResizer } - function GetActiveResizeFrame: IResizeFrame; virtual; abstract; - function GetActiveDesignedForm: IDesignedForm; virtual; abstract; - public { IResizer } - procedure TryBoundSizerToDesignedForm(Sender: TObject); virtual; - protected - // To perform proper behaviour for scroolbar with "PageSize" we need to remember real - // maximal values (is possible to scroll outside of range 0..(Max - PageSize), - // after mouse click in button responsible for changing value of scrollbar, - // our value is equal to Max :\). Workaround: we need to remember real max value in our own place - FRealMaxH: Integer; - FRealMaxV: Integer; - - FSpecialMargin: array[0..3] of Integer; - FDesignScroll: array[0..1] of Boolean; - - FParent: TWinControl; - FResizerFrameClass: TResizerFrameClass; - - function CreateResizeFrame: TBasicResizeFrame; virtual; - procedure NodePositioning(Sender: TObject; {%H-}PositioningKind: TPositioningKind; PositioningCode: TPositioningCode); - - function GetActiveFormAndFrame(out AForm: IDesignedForm; out AFrame: IResizeFrame): Boolean; - - procedure SetDesignScroll(AIndex: Integer; AValue: Boolean); - - procedure sbScroll(Sender: TObject; ScrollCode: TScrollCode; var ScrollPos: Integer); - public - pMainDTU: TPanel; - pMain: TPanel; - pAddons: TPanel; - pComponents: TPanel; - lInfo: TLabel; - sbShowComponents : TSpeedButton; - sbShowFormEditor: TSpeedButton; - sbShowAnchorEditor: TSpeedButton; - sbShowNonVisualEditor: TSpeedButton; - pDesignTimeUtils: TPanel; - sbV: TScrollBar; - sbH: TScrollBar; - - constructor Create(AParent: TWinControl; AResizerFrameClass: TResizerFrameClass); virtual; reintroduce; - property DesignScrollRight: Boolean index SB_Vert read FDesignScroll[SB_Vert] write SetDesignScroll; - property DesignScrollBottom: Boolean index SB_Horz read FDesignScroll[SB_Horz] write SetDesignScroll; - - property ActiveResizeFrame: IResizeFrame read GetActiveResizeFrame; - property ActiveDesignedForm: IDesignedForm read GetActiveDesignedForm; - end; - -implementation - -{ TAbstractResizer } - -procedure TAbstractResizer.TryBoundSizerToDesignedForm(Sender: TObject); -var - LWidth, LHeight: Integer; - LScrollPos: Integer; - LResizeFrame: IResizeFrame; - LFrame: TCustomFrame; - LForm: IDesignedForm; -begin - if not GetActiveFormAndFrame(LForm, LResizeFrame) then - Exit; - - LFrame := LResizeFrame.Frame; - LFrame.Constraints.MaxWidth := pMain.Width; - LFrame.Constraints.MaxHeight := pMain.Height; - - LWidth := LForm.Width + LResizeFrame.BgLeftMargin + LResizeFrame.BgRightMargin + 2*LResizeFrame.SizerRectSize; - LHeight := LForm.Height + LResizeFrame.BgTopMargin + LResizeFrame.BgBottomMargin + 2*LResizeFrame.SizerRectSize; - if not LResizeFrame.NodePositioning then - begin - LFrame.Width := LWidth; - LFrame.Height := LHeight; - // after enlargement and after reducing constrait not work for frame (LCL bug) - if LFrame.Width > LFrame.Constraints.MaxWidth then - LFrame.Width := LFrame.Constraints.MaxWidth; - if LFrame.Height > LFrame.Constraints.MaxHeight then - LFrame.Height := LFrame.Constraints.MaxHeight; - end; - - LResizeFrame.PositionNodes; - - DesignScrollBottom := LFrame.Width < LWidth; - sbH.Max := LWidth; - FRealMaxH := LWidth - LFrame.Width; - sbH.PageSize := LFrame.Width; - if LResizeFrame.HorizontalScrollPos > FRealMaxH then - begin - LResizeFrame.HorizontalScrollPos := FRealMaxH; - LScrollPos := LResizeFrame.HorizontalScrollPos; - sbScroll(sbH, scEndScroll, LScrollPos); - end; - - DesignScrollRight := LFrame.Height < LHeight; - sbV.Max := LHeight; - FRealMaxV := LHeight - LFrame.Height; - sbV.PageSize := LFrame.Height; - if LResizeFrame.VerticalScrollPos > FRealMaxV then - begin - LResizeFrame.VerticalScrollPos := FRealMaxV; - LScrollPos := LResizeFrame.VerticalScrollPos; - sbScroll(sbV, scEndScroll, LScrollPos); - end; - - {!} - LResizeFrame.ClientChangeBounds; - - // each editor can have scrolls in different positions. - // this is our place where we can call event to set scroll positions. - LScrollPos := LResizeFrame.VerticalScrollPos; - sbScroll(sbV, scEndScroll, LScrollPos); - LScrollPos := LResizeFrame.HorizontalScrollPos; - sbScroll(sbH, scEndScroll, LScrollPos); - - if Supports(LForm, IDesignedFormBackground) then - (LForm as IDesignedFormBackground).RefreshValues; - - LResizeFrame.DesignerSetFocus; -end; - -procedure TAbstractResizer.sbScroll(Sender: TObject; ScrollCode: TScrollCode; - var ScrollPos: Integer); -var - LScrollPos: Integer; - LFrame: IResizeFrame; - LForm: IDesignedForm; -begin - if not GetActiveFormAndFrame(LForm, LFrame) then - Exit; - - if ScrollCode <> scEndScroll then - LFrame.HideSizeRects - else - LFrame.ShowSizeRects; - - - LForm.BeginUpdate; - if Sender = sbV then - begin - // Warning - don't overflow the range! (go to description for FRealMaxV) - ScrollPos := Min(ScrollPos, FRealMaxV); - LFrame.VerticalScrollPos := ScrollPos; - // scroll for form - with LFrame do // -8 when we scaling the form and we don't need to scroll -> there is Max - LScrollPos := Max(ifthen(BgPanel.Top + BgTopMargin <= 0, ScrollPos - SizerRectSize - BgTopMargin, 0), 0); - LForm.VertScrollPosition := LScrollPos; - end; - if Sender = sbH then - begin - ScrollPos := Min(ScrollPos, FRealMaxH); - LFrame.HorizontalScrollPos := ScrollPos; - // scroll for form - with LFrame do - LScrollPos := Max(ifthen(BgPanel.Left + BgLeftMargin <= 0, ScrollPos - SizerRectSize - BgLeftMargin, 0), 0); - LForm.HorzScrollPosition := LScrollPos; - end; - LForm.EndUpdate; - - LFrame.PositionNodes; - - LForm.Form.Invalidate; -end; - -function TAbstractResizer.CreateResizeFrame: TBasicResizeFrame; -begin - Result := FResizerFrameClass.Create(FParent); - Result.Name := ''; - Result.Parent := pMain; - Result.Left := 0; - Result.Top := 0; - Result.OnNodePositioning := NodePositioning; -end; - -procedure TAbstractResizer.NodePositioning(Sender: TObject; - PositioningKind: TPositioningKind; PositioningCode: TPositioningCode); - -var - LForm: IDesignedForm; - LFrame: IResizeFrame; - - (*procedure Positioning; - var - LHiddenHeight, LNewHeight: Integer; - LHiddenWidth, LNewWidth: Integer; - begin - LForm.BeginUpdate; - - //if pkRight in PositioningKind then - begin - LHiddenWidth := sbH.Position; - if LHiddenWidth > LFrame.DesignedWidthToScroll then - LHiddenWidth := LFrame.DesignedWidthToScroll; - - // TODO - better handling of min width - same in TDesignedFormImpl.SetPublishedBounds (sparta_FakeCustom.pas) - - LNewWidth := LFrame.NewSize.X + LHiddenWidth; - LForm.Width := LNewWidth; - LForm.RealWidth := LNewWidth; - - // perform minimal width (TODO) - {if LNewWidth < DesignedForm.Width then - begin - FResizerFrame.pClient.Width := DesignedForm.Width; - Application.HandleMessage; - Application.ProcessMessages; - end;} - end; - - //if pkBottom in PositioningKind then - begin - LHiddenHeight := sbV.Position; - if LHiddenHeight > LFrame.DesignedHeightToScroll then - LHiddenHeight := LFrame.DesignedHeightToScroll; - - LNewHeight := LFrame.NewSize.Y+ LHiddenHeight; - LForm.Height := LNewHeight; - LForm.RealHeight := LNewHeight; - - // perform minimal height (TODO) - {if LNewHeight < DesignedForm.RealHeight then - begin - if FResizerFrame.pClient.Height < DesignedForm.RealHeight then - FResizerFrame.pClient.Height := DesignedForm.RealHeight; - Application.ProcessMessages; - end;} - end; - - LForm.EndUpdate; - end;*) - - procedure PositioningEnd; - var - LHiddenHeight, LNewHeight: Integer; - LHiddenWidth, LNewWidth: Integer; - begin - LHiddenWidth := sbH.Position; - if LHiddenWidth > LFrame.DesignedWidthToScroll then - LHiddenWidth := LFrame.DesignedWidthToScroll; - - LNewWidth := LFrame.NewSize.X + LHiddenWidth; - - LHiddenHeight := sbV.Position; - if LHiddenHeight > LFrame.DesignedHeightToScroll then - LHiddenHeight := LFrame.DesignedHeightToScroll; - - LNewHeight := LFrame.NewSize.Y + LHiddenHeight; - - LForm.Form.Width := LNewWidth; - LForm.Form.Height := LNewHeight; - end; - -begin - if not GetActiveFormAndFrame(LForm, LFrame) then - Exit; - - case PositioningCode of - pcPositioningEnd: PositioningEnd; - //pcPositioning: Positioning; - end; -end; - -function TAbstractResizer.GetActiveFormAndFrame(out AForm: IDesignedForm; out - AFrame: IResizeFrame): Boolean; -begin - AForm := GetActiveDesignedForm; - if AForm = nil then - Exit(False); - - AFrame := GetActiveResizeFrame; - Result := True; -end; - -procedure TAbstractResizer.SetDesignScroll(AIndex: Integer; AValue: Boolean); - - procedure PerformScroll(AScroll: TScrollBar); - begin - AScroll.Visible := AValue; - AScroll.Position:=0; - end; - -begin - if FDesignScroll[AIndex] = AValue then - Exit; - - FDesignScroll[AIndex] := AValue; - - case AIndex of - SB_Horz: PerformScroll(sbH); - SB_Vert: PerformScroll(sbV); - else - raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange); - end; -end; - -constructor TAbstractResizer.Create(AParent: TWinControl; - AResizerFrameClass: TResizerFrameClass); -begin - inherited Create(AParent); - - FResizerFrameClass := AResizerFrameClass; - FParent := AParent; - // create layout - - pMainDTU := TPanel.Create(Self); - with pMainDTU do - begin - Parent := AParent; - Align := alTop; - BevelOuter := bvNone; - Height := 0; - end; - - pAddons := TPanel.Create(Self); - pAddons.Parent := AParent; - pAddons.Align := alRight; - pAddons.BevelOuter := bvNone; - pAddons.Width:=0; - - sbV := TScrollBar.Create(Self); - with sbV do - begin - Kind := sbVertical; - Parent := AParent; - AnchorSideTop.Control := pMainDTU; - AnchorSideTop.Side := asrBottom; - AnchorSideRight.Control := pAddons; - AnchorSideBottom.Side := asrBottom; - Width := 17; - Anchors := [akTop, akRight, akBottom]; - Visible := False; - OnScroll := sbScroll; - end; - - sbH := TScrollBar.Create(Self); - with sbH do - begin - Parent := AParent; - AnchorSideLeft.Control := AParent; - AnchorSideRight.Side := asrRight; - AnchorSideBottom.Control := AParent; - AnchorSideBottom.Side := asrBottom; - Anchors := [akLeft, akRight, akBottom]; - Visible := False; - OnScroll := sbScroll; - end; - - pMain := TPanel.Create(Self); - with pMain do - begin - Parent := AParent; - AnchorSideLeft.Control := AParent; - AnchorSideTop.Control := pMainDTU; - AnchorSideTop.Side := asrBottom; - AnchorSideRight.Control := sbV; - AnchorSideBottom.Control := sbH; - Anchors := [akTop, akLeft, akRight, akBottom]; - BevelOuter := bvNone; - end; - - sbV.AnchorSideBottom.Control := pMain; - sbH.AnchorSideRight.Control := pMain; - - pMain.OnChangeBounds:=TryBoundSizerToDesignedForm; -end; - -end. - diff --git a/components/sparta/mdi/source/sparta_basicfakecustom.pas b/components/sparta/mdi/source/sparta_basicfakecustom.pas deleted file mode 100644 index ec1e6144a0..0000000000 --- a/components/sparta/mdi/source/sparta_basicfakecustom.pas +++ /dev/null @@ -1,548 +0,0 @@ -unit sparta_BasicFakeCustom; - -{$mode delphi}{$H+} - -interface - -uses - Classes, SysUtils, - LCLType, LCLIntf, Controls, Forms, - sparta_InterfacesMDI, sparta_FormBackgroundForMDI; - -type - - { TFormImpl } - - TFormImpl = class(TComponent, IDesignedRealFormHelper, IDesignedForm) - private - FDesignedRealForm: IDesignedRealForm; - FHackLeft: Integer; - FHackTop: Integer; - FHackWidth: Integer; - FHackHeight: Integer; - FOnChangeHackedBounds: TNotifyEvent; - protected - FForm: TCustomForm; - FUpdate: boolean; - procedure SetOnChangeHackedBounds(const AValue: TNotifyEvent); - function GetOnChangeHackedBounds: TNotifyEvent; - function PositionDelta: TPoint; - - function GetRealBounds(AIndex: Integer): Integer; virtual; - procedure SetRealBounds(AIndex: Integer; AValue: Integer); virtual; - function GetPublishedBounds(AIndex: Integer): Integer; virtual; - procedure SetPublishedBounds(AIndex: Integer; AValue: Integer); virtual; - - procedure SetHorzScrollPosition(AValue: Integer); virtual; - procedure SetVertScrollPosition(AValue: Integer); virtual; - - // own custom form scrool system - function GetHorzScrollPosition: Integer; virtual; - function GetVertScrollPosition: Integer; virtual; - - procedure SetRealBorderStyle(AVal: TFormBorderStyle); virtual; - procedure SetRealBorderIcons(AVal: TBorderIcons); virtual; - procedure SetRealFormStyle(AVal: TFormStyle); virtual; - procedure SetRealPopupMode(AVal: TPopupMode); virtual; - procedure SetRealPopupParent(AVal: TCustomForm); virtual; - - function GetRealBorderStyle: TFormBorderStyle; virtual; - function GetRealBorderIcons: TBorderIcons; virtual; - function GetRealFormStyle: TFormStyle; virtual; - function GetRealPopupMode: TPopupMode; virtual; - function GetRealPopupParent: TCustomForm; virtual; - - function GetForm: TCustomForm; virtual; - function GetUpdate: Boolean; virtual; - - procedure DoChangeHackedBounds; virtual; - - function GetLogicalClientRect(ALogicalClientRect: TRect): TRect; virtual; - public - property RealLeft: Integer index 0 read GetRealBounds write SetRealBounds; - property RealTop: Integer index 1 read GetRealBounds write SetRealBounds; - property RealWidth: Integer index 2 read GetRealBounds write SetRealBounds; - property RealHeight: Integer index 3 read GetRealBounds write SetRealBounds; - property RealBorderStyle: TFormBorderStyle read GetRealBorderStyle write SetRealBorderStyle; - property RealBorderIcons: TBorderIcons read GetRealBorderIcons write SetRealBorderIcons; - property RealFormStyle: TFormStyle read GetRealFormStyle write SetRealFormStyle; - - constructor Create(AOwner: TComponent; AForm: TCustomForm); virtual; reintroduce; - destructor Destroy; override; - - procedure BeginUpdate; virtual; - procedure EndUpdate({%H-}AModified: Boolean = False); virtual; - - procedure ShowWindow; virtual; - procedure HideWindow; virtual; - - property Update: Boolean read GetUpdate; - public - property Left: Integer index 0 read GetPublishedBounds write SetPublishedBounds; - property Top: Integer index 1 read GetPublishedBounds write SetPublishedBounds; - property Width: Integer index 2 read GetPublishedBounds write SetPublishedBounds; - property Height: Integer index 3 read GetPublishedBounds write SetPublishedBounds; - public - function QueryInterface(constref IID: TGUID; out Obj): HResult; override; - end; - - { TFormContainer } - - TFormContainer = class(TCustomForm, IDesignedRealForm, IDesignedForm, IDesignedFormBackground) - private - FDesignedForm: TFormImpl; - function GetDesignedForm: TFormImpl; - protected - property DesignedForm: TFormImpl read GetDesignedForm implements IDesignedForm; - function GetLogicalClientRect: TRect; override; - protected - function GetRealBounds(AIndex: Integer): Integer; virtual; - procedure SetRealBounds(AIndex: Integer; AValue: Integer); virtual; - function GetPublishedBounds(AIndex: Integer): Integer; virtual; - procedure SetPublishedBounds(AIndex: Integer; AValue: Integer); virtual; - - procedure SetRealBorderStyle(AVal: TFormBorderStyle); virtual; - procedure SetRealBorderIcons(AVal: TBorderIcons); virtual; - procedure SetRealFormStyle(AVal: TFormStyle); virtual; - procedure SetRealPopupMode(AVal: TPopupMode); virtual; - procedure SetRealPopupParent(AVal: TCustomForm); virtual; - - function GetRealBorderStyle: TFormBorderStyle; virtual; - function GetRealBorderIcons: TBorderIcons; virtual; - function GetRealFormStyle: TFormStyle; virtual; - function GetRealPopupMode: TPopupMode; virtual; - function GetRealPopupParent: TCustomForm; virtual; - protected - FHandledForm: TCustomForm; - FBackground: IDesignedFormBackground; - - procedure SetHandledForm(AForm: TCustomForm); - public - constructor CreateNew(AOwner: TComponent; Num: Integer = 0); override; - destructor Destroy; override; - - property HandledForm: TCustomForm read FHandledForm write SetHandledForm; - property Background: IDesignedFormBackground read FBackground implements IDesignedFormBackground; - published - property Left: Integer index 0 read GetPublishedBounds write SetPublishedBounds; - property Top: Integer index 1 read GetPublishedBounds write SetPublishedBounds; - property Width: Integer index 2 read GetPublishedBounds write SetPublishedBounds; - property Height: Integer index 3 read GetPublishedBounds write SetPublishedBounds; - property ClientWidth: Integer index 2 read GetPublishedBounds write SetPublishedBounds; - property ClientHeight: Integer index 3 read GetPublishedBounds write SetPublishedBounds; - end; - -implementation - -type - TFormAccess = class(TForm); - -{ TDesignedFormImpl } - -function TFormImpl.GetPublishedBounds(AIndex: Integer): Integer; -begin - case AIndex of - 0: Result := FForm.Left; - 1: Result := FForm.Top; - 2: Result := FForm.Width; - 3: Result := FForm.Height; - end; - //case AIndex of - // 0: Result := FHackLeft; - // 1: Result := FHackTop; - // 2: Result := FHackWidth; - // 3: Result := FHackHeight; - //end; -end; - -procedure TFormImpl.SetPublishedBounds(AIndex: Integer; AValue: Integer); -const - cMinWidth = 135; - cMaxWidth = 5*1024; // huge Mac monitors have 5K pixels width -begin - if AIndex = 2 then - if AValue < cMinWidth then - AValue := cMinWidth; - - if AIndex in [2, 3] then - if AValue > cMaxWidth then - AValue := cMaxWidth; - - case AIndex of - 0: FHackLeft := AValue; - 1: FHackTop := AValue; - 2: FHackWidth := AValue; - 3: FHackHeight := AValue; - end; - - DoChangeHackedBounds; -end; - -{----------------------------------------------- - Real values inherited for design form -{----------------------------------------------} - -function TFormImpl.GetRealBounds(AIndex: Integer): Integer; -begin - case AIndex of - 0: Result := FForm.Left; - 1: Result := FForm.Top; - 2: Result := FForm.Width; - 3: Result := FForm.Height; - end; - - //FForm.; - //Result := 0;// FDesignedRealForm.GetRealBounds(AIndex); -end; - -procedure TFormImpl.SetRealBounds(AIndex: Integer; AValue: Integer); - - procedure AdjustSize; - var - LFormRect: TRect; - LRealValue, LValue: Integer; - begin - LFormRect := Rect(0, 0, 0, 0);; - LCLIntf.GetClientRect(GetForm.Handle, LFormRect); - LRealValue := GetRealBounds(AIndex); - LValue := LFormRect.Vector[AIndex]; - - if LValue <> LRealValue then - FDesignedRealForm.SetRealBounds(AIndex, AValue - (LRealValue - LValue)); - end; - -begin - {FDesignedRealForm.SetRealBounds(AIndex, AValue); - - if AIndex = 2 then - AdjustSize;} -end; - -procedure TFormImpl.SetRealBorderStyle(AVal: TFormBorderStyle); -begin - //FDesignedRealForm.SetRealBorderStyle(AVal); -end; - -procedure TFormImpl.SetRealBorderIcons(AVal: TBorderIcons); -begin - //FDesignedRealForm.SetRealBorderIcons(AVal); -end; - -procedure TFormImpl.SetRealFormStyle(AVal: TFormStyle); -begin - //FDesignedRealForm.SetRealFormStyle(AVal); -end; - -procedure TFormImpl.SetRealPopupMode(AVal: TPopupMode); -begin - //FDesignedRealForm.SetRealPopupMode(AVal); -end; - -procedure TFormImpl.SetRealPopupParent(AVal: TCustomForm); -begin - //FDesignedRealForm.SetRealPopupParent(AVal); -end; - -function TFormImpl.GetRealBorderStyle: TFormBorderStyle; -begin - Result := bsNone;//FDesignedRealForm.GetRealBorderStyle; -end; - -function TFormImpl.GetRealBorderIcons: TBorderIcons; -begin - Result := [];//FDesignedRealForm.GetRealBorderIcons; -end; - -function TFormImpl.GetRealFormStyle: TFormStyle; -begin - Result := fsNormal;//FDesignedRealForm.GetRealFormStyle; -end; - -function TFormImpl.GetRealPopupMode: TPopupMode; -begin - Result := pmNone//FDesignedRealForm.GetRealPopupMode; -end; - -function TFormImpl.GetRealPopupParent: TCustomForm; -begin - Result := nil//FDesignedRealForm.GetRealPopupParent; -end; - -////// - -function TFormImpl.GetForm: TCustomForm; -begin - Result := FForm; -end; - -function TFormImpl.GetUpdate: Boolean; -begin - Result := FUpdate; -end; - -function TFormImpl.GetOnChangeHackedBounds: TNotifyEvent; -begin - Result := FOnChangeHackedBounds; -end; - -function TFormImpl.PositionDelta: TPoint; - - procedure FormBorderDelta; - begin - Result.X := GetSystemMetrics(SM_CXSIZEFRAME); - Result.Y := GetSystemMetrics(SM_CYSIZEFRAME) + GetSystemMetrics(SM_CYCAPTION); - end; - -begin - Result := Point(0, 0); - {$IFDEF WINDOWS} - FormBorderDelta; - {$ENDIF} -end; - -procedure TFormImpl.SetOnChangeHackedBounds(const AValue: TNotifyEvent); -begin - FOnChangeHackedBounds := AValue; -end; - -/////// positions - -procedure TFormImpl.SetHorzScrollPosition(AValue: Integer); -begin - RealLeft := -PositionDelta.x - AValue; - // ! must. resize problem for controls with Align = Top, Right etc. - RealWidth := Width; - RealHeight := Height; -end; - -procedure TFormImpl.SetVertScrollPosition(AValue: Integer); -begin - RealTop := -PositionDelta.y - AValue; - // ! must. resize problem for controls with Align = Top, Right etc. - RealWidth := Width; - RealHeight := Height; -end; - -function TFormImpl.GetHorzScrollPosition: Integer; -begin - Result := -(RealLeft {+ PositionDelta.x}); -end; - -function TFormImpl.GetVertScrollPosition: Integer; -begin - Result := -(RealTop {+ PositionDelta.y}); -end; - -procedure TFormImpl.BeginUpdate; -begin - FUpdate := True; -end; - -procedure TFormImpl.EndUpdate(AModified: Boolean); -begin - FUpdate := False; -end; - -procedure TFormImpl.ShowWindow; -begin - if FForm.Parent = nil then - LCLIntf.ShowWindow(FForm.Handle, SW_SHOW); -end; - -procedure TFormImpl.HideWindow; -begin - if FForm.Parent = nil then - LCLIntf.ShowWindow(FForm.Handle, SW_HIDE); -end; - -function TFormImpl.QueryInterface(constref IID: TGUID; out Obj - ): HResult; -begin - Result := inherited QueryInterface(IID, Obj); - if Result <> S_OK then - Result := TFormAccess(FForm).QueryInterface(IID, Obj); -end; - -procedure TFormImpl.DoChangeHackedBounds; -begin - if not FUpdate and Assigned(FOnChangeHackedBounds) then - FOnChangeHackedBounds(FForm); -end; - -function TFormImpl.GetLogicalClientRect(ALogicalClientRect: TRect): TRect; -begin - Result:=ALogicalClientRect; -end; - -constructor TFormImpl.Create(AOwner: TComponent; AForm: TCustomForm); -begin - inherited Create(AOwner); - FForm := AForm; - FDesignedRealForm := Self as IDesignedRealForm; -end; - -destructor TFormImpl.Destroy; -begin - Pointer(FDesignedRealForm) := nil; - inherited Destroy; -end; - -{ TFakeCustomForm } - -function TFormContainer.GetDesignedForm: TFormImpl; -begin - if not Assigned(FDesignedForm) then - FDesignedForm := TFormImpl.Create(Self, Self); - - Result := FDesignedForm; -end; - -function TFormContainer.GetLogicalClientRect: TRect; -begin - Result := DesignedForm.GetLogicalClientRect(inherited GetLogicalClientRect); -end; - -function TFormContainer.GetRealBounds(AIndex: Integer): Integer; -begin - case AIndex of - 0: Result := inherited Left; - 1: Result := inherited Top; - 2: Result := inherited Width; - 3: Result := inherited Height; - end; -end; - -procedure TFormContainer.SetRealBounds(AIndex: Integer; AValue: Integer); -begin - case AIndex of - 0: inherited Left := AValue; - 1: inherited Top := AValue; - 2: - begin - inherited Width := AValue; - if FHandledForm <> nil then - FHandledForm.Width := AValue; - end; - 3: - begin - inherited Height := AValue; - if FHandledForm <> nil then - FHandledForm.Height := AValue; - end; - end; -end; - -function TFormContainer.GetPublishedBounds(AIndex: Integer): Integer; -begin - Result := DesignedForm.GetPublishedBounds(AIndex); -end; - -procedure TFormContainer.SetPublishedBounds(AIndex: Integer; AValue: Integer); -begin - case AIndex of - 0, 1: DesignedForm.SetPublishedBounds(AIndex, AValue); - 2, 3: - begin - DesignedForm.SetPublishedBounds(AIndex, AValue); - SetRealBounds(AIndex, DesignedForm.GetPublishedBounds(AIndex)); - end; - end; -end; - -constructor TFormContainer.CreateNew(AOwner: TComponent; Num: Integer); -begin - FBackground := TfrFormBackgroundForMDI.Create(DesignedForm); - FBackground._AddRef; - - inherited CreateNew(AOwner, Num); - - Left := inherited Left; - Top := inherited Top; - Width := inherited Width; - Height := inherited Height; -end; - -destructor TFormContainer.Destroy; -var - I: IInterfaceComponentReference; -begin - // we need to call "Screen.RemoveForm" to perform - // references back to nil by IDesignedForm to FDesignedForm - inherited Destroy; - - FBackground.QueryInterface(IInterfaceComponentReference, I); // only way to omit SIGSEGV - I.GetComponent.Free; - Pointer(I) := nil; // omit _Release (Free is above) - Pointer(FBackground) := nil; // omit _Release (Free is above) - - if Assigned(FDesignedForm) then - FreeAndNil(FDesignedForm); -end; - -procedure TFormContainer.SetRealBorderStyle(AVal: TFormBorderStyle); -begin - inherited BorderStyle := AVal; -end; - -procedure TFormContainer.SetRealBorderIcons(AVal: TBorderIcons); -begin - inherited BorderIcons := AVal; -end; - -procedure TFormContainer.SetRealFormStyle(AVal: TFormStyle); -begin - inherited FormStyle := AVal; -end; - -procedure TFormContainer.SetRealPopupMode(AVal: TPopupMode); -begin - inherited PopupMode := AVal; -end; - -procedure TFormContainer.SetRealPopupParent(AVal: TCustomForm); -begin - inherited PopupParent := AVal; -end; - -function TFormContainer.GetRealBorderStyle: TFormBorderStyle; -begin - Result := inherited BorderStyle; -end; - -function TFormContainer.GetRealBorderIcons: TBorderIcons; -begin - Result := inherited BorderIcons; -end; - -function TFormContainer.GetRealFormStyle: TFormStyle; -begin - Result := inherited FormStyle; -end; - -function TFormContainer.GetRealPopupMode: TPopupMode; -begin - Result := inherited PopupMode; -end; - -function TFormContainer.GetRealPopupParent: TCustomForm; -begin - Result := inherited PopupParent; -end; - -procedure TFormContainer.SetHandledForm(AForm: TCustomForm); -begin - if FHandledForm = AForm then - Exit; - - if FHandledForm <> nil then - FHandledForm.Parent := nil; - - FHandledForm := AForm; - - if FHandledForm <> nil then - FHandledForm.Parent := Self; -end; - - -end. - diff --git a/components/sparta/mdi/source/sparta_basicresizeframe.lfm b/components/sparta/mdi/source/sparta_basicresizeframe.lfm deleted file mode 100644 index ebc9fabaa3..0000000000 --- a/components/sparta/mdi/source/sparta_basicresizeframe.lfm +++ /dev/null @@ -1,216 +0,0 @@ -object BasicResizeFrame: TBasicResizeFrame - Left = 0 - Height = 460 - Top = 0 - Width = 320 - ClientHeight = 460 - ClientWidth = 320 - ParentFont = False - TabOrder = 0 - DesignLeft = 789 - DesignTop = 488 - object pR: TPanel - AnchorSideTop.Control = Owner - Cursor = crSizeWE - Left = 296 - Height = 443 - Top = 37 - Width = 8 - Anchors = [] - BevelOuter = bvNone - ClientHeight = 443 - ClientWidth = 8 - Color = clNone - ParentColor = False - TabOrder = 0 - object pMarginR: TPanel - AnchorSideLeft.Control = pR - AnchorSideTop.Control = pR - AnchorSideBottom.Control = pR - AnchorSideBottom.Side = asrBottom - Left = 0 - Height = 429 - Top = 7 - Width = 1 - Anchors = [akTop, akLeft, akBottom] - BorderSpacing.Top = 7 - BorderSpacing.Bottom = 7 - BevelOuter = bvNone - Color = clWhite - ParentColor = False - TabOrder = 0 - end - end - object pB: TPanel - AnchorSideLeft.Control = Owner - Cursor = crSizeNS - Left = 0 - Height = 8 - Top = 436 - Width = 303 - Anchors = [akLeft, akRight] - BevelOuter = bvNone - ClientHeight = 8 - ClientWidth = 303 - Color = clNone - ParentColor = False - TabOrder = 1 - object pMarginB: TPanel - AnchorSideLeft.Control = pB - AnchorSideTop.Control = pB - AnchorSideRight.Control = pB - AnchorSideRight.Side = asrBottom - Left = 7 - Height = 1 - Top = 0 - Width = 289 - Anchors = [akTop, akLeft, akRight] - BorderSpacing.Left = 7 - BorderSpacing.Right = 7 - TabOrder = 0 - end - end - object pL: TPanel - AnchorSideLeft.Control = Owner - AnchorSideTop.Control = Owner - Left = 1 - Height = 443 - Top = 37 - Width = 8 - Anchors = [] - BevelOuter = bvNone - ClientHeight = 443 - ClientWidth = 8 - Color = clNone - ParentColor = False - TabOrder = 2 - object pMarginL: TPanel - AnchorSideTop.Control = pL - AnchorSideRight.Control = pL - AnchorSideRight.Side = asrBottom - AnchorSideBottom.Control = pL - AnchorSideBottom.Side = asrBottom - Left = 7 - Height = 429 - Top = 7 - Width = 1 - Anchors = [akTop, akRight, akBottom] - BorderSpacing.Top = 7 - BorderSpacing.Bottom = 7 - BevelOuter = bvNone - Color = clWhite - ParentColor = False - TabOrder = 0 - end - end - object pT: TPanel - AnchorSideLeft.Control = Owner - AnchorSideTop.Control = Owner - Left = 0 - Height = 8 - Top = 1 - Width = 303 - Anchors = [akLeft, akRight] - BevelOuter = bvNone - ClientHeight = 8 - ClientWidth = 303 - Color = clNone - ParentColor = False - TabOrder = 3 - object pMarginT: TPanel - AnchorSideLeft.Control = pT - AnchorSideRight.Control = pT - AnchorSideRight.Side = asrBottom - AnchorSideBottom.Control = pT - AnchorSideBottom.Side = asrBottom - Left = 7 - Height = 1 - Top = 7 - Width = 289 - Anchors = [akLeft, akRight, akBottom] - BorderSpacing.Left = 7 - BorderSpacing.Right = 7 - BevelOuter = bvNone - Color = clWhite - ParentColor = False - TabOrder = 0 - end - end - object iResizerLineImg: TImage - Left = 216 - Height = 6 - Top = 32 - Width = 6 - AutoSize = True - Picture.Data = { - 1754506F727461626C654E6574776F726B477261706869639100000089504E47 - 0D0A1A0A0000000D4948445200000006000000060806000000E0CCEF48000000 - 06624B474400FF00FF00FFA0BDA793000000097048597300000EC400000EC401 - 952B0E1B0000000774494D4507DD0A07131110E51DAB140000001E4944415408 - D76358B060C17F06060606749A019BE082050BFE33D04107001B6C33AF54FD1B - 500000000049454E44AE426082 - } - Visible = False - end - object pBG: TPanel - AnchorSideLeft.Control = pL - AnchorSideLeft.Side = asrBottom - AnchorSideTop.Control = pT - AnchorSideTop.Side = asrBottom - AnchorSideRight.Control = pR - AnchorSideBottom.Control = pB - Left = 9 - Height = 427 - Top = 9 - Width = 287 - Anchors = [akTop, akLeft, akRight, akBottom] - BevelOuter = bvNone - ClientHeight = 427 - ClientWidth = 287 - TabOrder = 4 - OnPaint = pBGPaint - object pFakeMenu: TPanel - AnchorSideLeft.Control = pBG - AnchorSideTop.Control = pBG - AnchorSideRight.Control = pBG - AnchorSideRight.Side = asrBottom - Left = 0 - Height = 50 - Top = 0 - Width = 287 - Anchors = [akTop, akLeft, akRight] - BevelOuter = bvNone - TabOrder = 0 - Visible = False - OnPaint = pFakeMenuPaint - end - end - object pClient: TPanel - AnchorSideLeft.Control = pL - AnchorSideLeft.Side = asrBottom - AnchorSideTop.Control = pT - AnchorSideTop.Side = asrBottom - AnchorSideRight.Control = pR - AnchorSideBottom.Control = pB - Left = 13 - Height = 152 - Top = 13 - Width = 152 - Anchors = [] - BevelOuter = bvNone - ClientHeight = 152 - ClientWidth = 152 - Color = clBtnFace - ParentColor = False - TabOrder = 5 - object pFormHandler: TPanel - Left = 24 - Height = 33 - Top = 56 - Width = 113 - BevelOuter = bvNone - ParentColor = False - TabOrder = 0 - end - end -end diff --git a/components/sparta/mdi/source/sparta_basicresizeframe.pas b/components/sparta/mdi/source/sparta_basicresizeframe.pas deleted file mode 100644 index e35ccc7bfb..0000000000 --- a/components/sparta/mdi/source/sparta_basicresizeframe.pas +++ /dev/null @@ -1,1147 +0,0 @@ -unit sparta_BasicResizeFrame; - -{$mode delphi}{$H+} - -interface - -uses - Classes, Types, contnrs, SysUtils, Math, - FileUtil, - LCLType, LCLIntf, LMessages, Forms, Controls, ExtCtrls, StdCtrls, Graphics, Menus, - sparta_InterfacesMDI; - -type - TPositioningCode = (pcPositioning, pcPositioningEnd); - TPositioningKind = set of (pkBottom, pkRight); - TPositioningEvent = procedure(Sender: TObject; PositioningKind: TPositioningKind; PositioningCode: TPositioningCode) of object; - - { TBasicResizeFrame } - - TResizerFrameClass = class of TBasicResizeFrame; - TBasicResizeFrame = class(TFrame, IResizeFrame) - iResizerLineImg: TImage; - pFormHandler: TPanel; - pFakeMenu: TPanel; - pBG: TPanel; - pB: TPanel; - pClient: TPanel; - pL: TPanel; - pMarginB: TPanel; - pMarginL: TPanel; - pMarginR: TPanel; - pMarginT: TPanel; - pR: TPanel; - pT: TPanel; - procedure pBGPaint(Sender: TObject); - procedure pFakeMenuPaint(Sender: TObject); - procedure sbVerticalScroll(Sender: TObject; ScrollCode: TScrollCode; - var ScrollPos: Integer); - procedure sbHorizontalScroll(Sender: TObject; ScrollCode: TScrollCode; - var ScrollPos: Integer); - public const - SIZER_RECT_SIZE = 8; - SIZER_LINE_WIDTH = 8; - private - FVerticalScrollPos: Integer; - FHorizontalScrollPos: Integer; - FDesignedForm: IDesignedForm; - FBackground: IDesignedFormBackground; - FFakeFocusControl: TWinControl; - - procedure FakeExitEnter(Sender: TObject); - procedure FakeKeyDown(Sender: TObject; var Key: Word; {%H-}Shift: TShiftState); - procedure FakeKeyUp(Sender: TObject; var Key: Word; {%H-}Shift: TShiftState); - procedure FakeUTF8KeyPress(Sender: TObject; var UTF8Key: TUTF8Char); - private - FOnNodePositioning: TPositioningEvent; - FOnHorizontalScroll, FOnVerticalScroll: TScrollEvent; - FLastRightMarign: Integer; - FLastBottomMarign: Integer; - FNodePositioning: Boolean; - FOldPos, FDelta: TPoint; - FPositioningKind: TPositioningKind; - FMaxWidth, FMaxHeight: Integer; - FLastClientWidth, FLastClientHeight: Integer; - FLastDesignedWidthToScroll, FLastDesignedHeightToScroll: Integer; - FOldHasMainMenu: Boolean; - FDesignerModified: Boolean; - FSizerLineWidth: Integer; - FSizerRectSize: Integer; - - function HasMainMenu: Boolean; - procedure AppOnIdle(Sender: TObject; var {%H-}Done: Boolean); - - procedure PanelPaint(Sender: TObject); - procedure BGChangeBounds(Sender: TObject); - - procedure CreateNodes; - procedure NodeMouseDown(Sender: TObject; {%H-}Button: TMouseButton; {%H-}Shift: TShiftState; {%H-}X, {%H-}Y: Integer); - procedure NodeMouseMove(Sender: TObject; {%H-}Shift: TShiftState; {%H-}X, {%H-}Y: Integer); - procedure NodeMouseUp(Sender: TObject; {%H-}Button: TMouseButton; {%H-}Shift: TShiftState; {%H-}X, {%H-}Y: Integer); - - function GetRightMargin: Integer; - function GetBottomMargin: Integer; - - // dependent on scroll position - // for Vertical - function BottomSizerRectHeight: Integer; - function BottomSizerLineWidth: Integer; - function TopSizerRectTop: Integer; - function TopSizerLineWidth: Integer; - function VerticalSizerLineLength: Integer; - // for Horizontal - function RightSizerRectWidth: Integer; - function RightSizerLineWidth: Integer; - function LeftSizerRectLeft: Integer; - function LeftSizerLineWidth: Integer; - function HorizontalSizerLineLength: Integer; - - procedure AdjustFormHandler; - - function GetMenuHeight: Integer; - protected - FNodes: TObjectList; - protected - procedure TryBoundDesignedForm; virtual; - procedure BeginFormSizeUpdate(Sender: TObject); virtual; - procedure EndFormSizeUpdate(Sender: TObject); virtual; - protected { IResizeFrame } - procedure HideSizeRects; - procedure ShowSizeRects; - procedure PositionNodes; overload; - function DesignedWidthToScroll: Integer; - function DesignedHeightToScroll: Integer; - procedure ClientChangeBounds; overload; - - function GetFrame: TCustomFrame; - function GetVerticalScrollPos: Integer; - procedure SetVerticalScrollPos(AValue: Integer); - function GetHorizontalScrollPos: Integer; - procedure SetHorizontalScrollPos(AValue: Integer); - - function GetBackgroundPanel: TPanel; - function GetBackgroundMargin(const AIndex: Integer): Integer; - - function GetNewSize: TPoint; - function GetFormHandler: TPanel; - function GetNodePositioning: Boolean; - function GetDesignedForm: IDesignedForm; - procedure SetDesignedForm(const AValue: IDesignedForm); - - function GetSizerRectSize: Integer; - function GetSizerLineWidth: Integer; - public { IResizeFrame } - procedure DesignerSetFocus; - public - constructor Create(TheOwner: TComponent); override; - destructor Destroy; override; - - property DesignedForm: IDesignedForm read GetDesignedForm write SetDesignedForm; - - procedure PositionNodes(AroundControl: TWinControl); overload; - property NodePositioning: Boolean read GetNodePositioning; - procedure ClientChangeBounds(Sender: TObject); overload; - - property RightMargin: Integer read GetRightMargin; - property BottomMargin: Integer read GetBottomMargin; - property OnNodePositioning: TPositioningEvent read FOnNodePositioning write FOnNodePositioning; - - property BgLeftMargin: Integer index 0 read GetBackgroundMargin; - property BgTopMargin: Integer index 1 read GetBackgroundMargin; - property BgRightMargin: Integer index 2 read GetBackgroundMargin; - property BgBottomMargin: Integer index 3 read GetBackgroundMargin; - property SizerRectSize: Integer read FSizerRectSize; - property SizerLineWidth: Integer read FSizerLineWidth; - - procedure HideSizeControls; - procedure ShowSizeControls; - - procedure OnModified; - - property VerticalScrollPos: Integer read GetVerticalScrollPos write SetVerticalScrollPos; - property HorizontalScrollPos: Integer read GetHorizontalScrollPos write SetHorizontalScrollPos; - end; - -implementation - -{$R *.lfm} - -{ Node grip indices are as follows: - - 1 -0 +----+----+ 2 - | | -7 + + 3 - | | -6 +----+----+ 4 - 5 - -Only grips 3, 4, and 5 are sizeable } - -procedure TBasicResizeFrame.pFakeMenuPaint(Sender: TObject); -var - MenuRect: Types.TRect; - Menu: TMainMenu; - X, Y, I: Integer; - LCanvas: TCanvas; -begin - //fake paint menu - - MenuRect := pFakeMenu.ClientRect; - LCanvas := pFakeMenu.Canvas; - LCanvas.Brush.Color := clMenuBar; - LCanvas.FillRect(MenuRect); - - // pFakeMenu is visible only when HasMainMenu is true - // but FDesignedForm can be nil if the designer is painted before it has been assigned - if not HasMainMenu then - Exit; - - Menu := FDesignedForm.Form.Menu; - LCanvas.Font.Color := clMenuText; - - X := 5; - Y := (MenuRect.Top+MenuRect.Bottom-LCanvas.TextHeight('Hg')) div 2; - for I := 0 to Menu.Items.Count-1 do - if Menu.Items[I].Visible then - begin - LCanvas.TextOut(X, Y, Menu.Items[I].Caption); - Inc(X, LCanvas.TextWidth(Menu.Items[I].Caption) + 10); - end; -end; - -procedure TBasicResizeFrame.pBGPaint(Sender: TObject); -begin - pBG.SendToBack; -end; - -procedure TBasicResizeFrame.sbVerticalScroll(Sender: TObject; - ScrollCode: TScrollCode; var ScrollPos: Integer); -begin - if ScrollCode <> scEndScroll then - HideSizeRects - else - ShowSizeRects; - - FVerticalScrollPos := ScrollPos; - - PositionNodes(Self); - - if Assigned(FOnVerticalScroll) - // for refresh from this class, pass sender as nil. - // In other case program will go into infinity loop - and (Sender <> nil) then - FOnVerticalScroll(Sender, ScrollCode, ScrollPos); -end; - -procedure TBasicResizeFrame.sbHorizontalScroll(Sender: TObject; - ScrollCode: TScrollCode; var ScrollPos: Integer); -begin - if ScrollCode <> scEndScroll then - HideSizeRects - else - ShowSizeRects; - - FHorizontalScrollPos := ScrollPos; - - PositionNodes(Self); - - if Assigned(FOnHorizontalScroll) - // for refresh from this class, pass sender as nil. - // In other case program will go into infinity loop - and (Sender <> nil) then - FOnHorizontalScroll(Sender, ScrollCode, ScrollPos); -end; - -{ TResizerFrame } - -// Tiles the source image over the given target canvas -procedure TileImage(const ASource: TImage; ATarget: TCanvas; AX, AY, - AWidth, AHeight: Integer); -var - LX, LY, LDeltaX, LDeltaY: Integer; -begin - LDeltaX := ASource.Width; - LDeltaY := ASource.Height; - LY := 0; - while LY < AHeight do - begin - LX := 0; - while LX < AWidth do - begin - ATarget.Draw(AX + LX, AY + LY, ASource.Picture.graphic); - Inc(LX, LDeltaX); - end; - Inc(LY, LDeltaY); - end; -end; - -procedure TBasicResizeFrame.PanelPaint(Sender: TObject); -var - LWidth, LHeight: Integer; - LOldColor: TColor; - LCanvas: TCanvas; -begin - if FNodePositioning then - Exit; - if (Sender = pR) or (Sender = pL) then - begin - LWidth := SizerLineWidth; - LHeight := Height; - end else - begin - LWidth := Width; - LHeight := SizerLineWidth; - end; - LCanvas := (Sender as TPanel).Canvas; - if FFakeFocusControl.Focused then - begin - LOldColor := LCanvas.Brush.Color; - LCanvas.Brush.Color := $FFEEDD; - LCanvas.FillRect(0, 0, LWidth, LHeight); - LCanvas.Brush.Color := LOldColor; - end; - TileImage(iResizerLineImg, LCanvas, 0, 0, LWidth, LHeight); -end; - -procedure TBasicResizeFrame.ClientChangeBounds(Sender: TObject); -begin - if (DesignedForm = nil) or FNodePositioning then - Exit; - - FLastClientWidth := pClient.Width; - FLastClientHeight := pClient.Height; - -(* - DesignedForm.BeginUpdate; - - DesignedForm.RealLeft := 0; - DesignedForm.RealTop := 0; - DesignedForm.RealWidth := pClient.Width; - DesignedForm.RealHeight := pClient.Height; - DesignedForm.EndUpdate; -*) -end; - -procedure TBasicResizeFrame.BGChangeBounds(Sender: TObject); -begin - PositionNodes(Self); -end; - -procedure TBasicResizeFrame.HideSizeRects; -var - p: TObject; - wc: TWinControl absolute p; -begin - for p in FNodes do - if not (wc is TPanel) then - wc.Visible := False; -end; - -procedure TBasicResizeFrame.HideSizeControls; -begin - pL.Repaint; - pT.Repaint; - pR.Repaint; - pB.Repaint; - - HideSizeRects; - pBG.SendToBack; -end; - -procedure TBasicResizeFrame.ShowSizeRects; -var - p: TObject; - wc: TWinControl absolute p; -begin - for p in FNodes do - wc.Visible := True; -end; - -procedure TBasicResizeFrame.PositionNodes; -begin - PositionNodes(Self); -end; - -procedure TBasicResizeFrame.ShowSizeControls; -begin - pL.Repaint; - pT.Repaint; - pR.Repaint; - pB.Repaint; - - ShowSizeRects; - //pBG.Visible := True; -end; - -procedure TBasicResizeFrame.CreateNodes; -var - Node: Integer; - Panel: TPanel; -begin - for Node := 0 to 7 do - begin - Panel := TPanel.Create(self); - with Panel do - begin - BevelOuter := bvNone; - Color := clBlack; - - Name := 'Node' + IntToStr(Node); - Caption:=''; - Width := SIZER_RECT_SIZE; // scaled dynamically by LCL - Height := SIZER_RECT_SIZE; // scaled dynamically by LCL - Parent := Self; - Visible := True; - FNodes.Add(Panel); - - case Node of - // on mac there is no cursor for crNWSE ( https://bugs.freepascal.org/view.php?id=32194#c101876 ) - {0,}4: Cursor := {$IFDEF MACOS}crSizeAll{$ELSE}crSizeNWSE{$ENDIF}; - {1,}5: Cursor := crSizeNS; - //{2,}6: Cursor := $IFDEF MACOS}crSizeAll{$ELSE}crSizeNESW{$ENDIF}; - 3{,7}: Cursor := crSizeWE; - end; - if Node in [3,4,5] then - begin - OnMouseDown := NodeMouseDown; - OnMouseMove := NodeMouseMove; - OnMouseUp := NodeMouseUp; - end; - - with TShape.Create(Panel) do - begin - Parent := Panel; - Align:= alClient; - Enabled := False; - - if Node in [3,4,5] then - Brush.Color:=clBtnFace - else - Brush.Color:=clGray; - end; - end; - end; - // extra resizers - pB.OnMouseDown := NodeMouseDown; - pB.OnMouseMove := NodeMouseMove; - pB.OnMouseUp := NodeMouseUp; - - pR.OnMouseDown := NodeMouseDown; - pR.OnMouseMove := NodeMouseMove; - pR.OnMouseUp := NodeMouseUp; - - FNodes.Add(pL); - FNodes.Add(pT); - FNodes.Add(pR); - FNodes.Add(pB); -end; - -procedure TBasicResizeFrame.NodeMouseDown(Sender: TObject; Button: TMouseButton; - Shift: TShiftState; X, Y: Integer); -var - LCtrlPoint: TPoint; -begin - { TShape in TBasicResizeFrame.CreateNodes is disabled, anyway in future can be usefull - if Sender is TGraphicControl then - Sender := TGraphicControl(Sender).Parent;} - - if (Enabled) and (Sender is TWinControl) then - begin - FNodePositioning:=True; - BeginFormSizeUpdate(Sender); - - // when we start resizing the rules do not apply to us :) - FMaxWidth := Constraints.MaxWidth; - FMaxHeight := Constraints.MaxHeight; - Constraints.MaxWidth := 0; - Constraints.MaxHeight := 0; - with pClient do - begin - Align := alClient; - if pBG.Left + BgLeftMargin <= 0 then - BorderSpacing.Left := Max(-pBG.Left - (FHorizontalScrollPos - SizerRectSize), 0) - else - BorderSpacing.Left := Max(pBG.Left + BgLeftMargin, 0); - - if pBG.Top + BgTopMargin <= 0 then - BorderSpacing.Top := Max(-pBG.Top - (FVerticalScrollPos - SizerRectSize), 0) - else - BorderSpacing.Top := Max(pBG.Top + BgTopMargin, 0); - - BorderSpacing.Right := Max(Self.Width - (pR.Left - BgRightMargin), 0); - BorderSpacing.Bottom := Max(Self.Height - (pB.Top - BgBottomMargin), 0); - end; - - - {$IF Defined(LCLWin32) or Defined(LCLWin64)} - SetCapture(TWinControl(Sender).Handle); - {$ENDIF} - GetCursorPos(FOldPos); - // perform first "click delta" to reduce leap - // + calculate delta created by scrollbars and theirs position... - FillChar(FDelta, SizeOf(FDelta), #0); - LCtrlPoint := (Sender as TWinControl).ScreenToClient(Mouse.CursorPos); - if Sender = pR then - begin - FDelta.X := -(LCtrlPoint.x - RightSizerLineWidth) + RightMargin + Left; - FPositioningKind := [pkRight]; - end - else if Sender = pB then - begin - FDelta.Y := -(LCtrlPoint.y - BottomSizerLineWidth) + BottomMargin + Top; - FPositioningKind := [pkBottom]; - end - else - case FNodes.IndexOf(Sender) of - 3: // middle right - begin - FDelta.X := -(LCtrlPoint.x - RightSizerRectWidth) + RightMargin + Left; - FPositioningKind := [pkRight]; - end; - 4: // right bottom - begin - FDelta.X := -(LCtrlPoint.x - RightSizerRectWidth) + RightMargin + Left; - FDelta.Y := -(LCtrlPoint.y - BottomSizerRectHeight) + BottomMargin + Top; - FPositioningKind := [pkRight, pkBottom]; - end; - 5: // middle bottom - begin - FDelta.Y := -(LCtrlPoint.y - BottomSizerRectHeight) + BottomMargin + Top; - FPositioningKind := [pkBottom]; - end; - end; - end; -end; - -procedure TBasicResizeFrame.NodeMouseMove(Sender: TObject; Shift: TShiftState; X, - Y: Integer); -var - newPos: TPoint; - frmPoint : TPoint; - OldRect: TRect; - AdjL,AdjR,AdjT,AdjB: Boolean; -begin - { TShape in TBasicResizeFrame.CreateNodes is disabled, anyway in future can be usefull - // handle TPanel for resizing rectangles - if Sender is TGraphicControl then - Sender := TGraphicControl(Sender).Parent;} - - if FNodePositioning then - begin - with TWinControl(Sender) do - begin - newPos := Point(0, 0); - GetCursorPos(newPos); - - if (newPos.x = FOldPos.x) and (newPos.y = FOldPos.y) then - Exit; - - HideSizeControls; - UpdateWindow(pBG.Handle); - UpdateWindow(Self.Handle); - UpdateWindow(Self.Parent.Handle); - with Self do - begin //resize - frmPoint := Self.ScreenToClient(Mouse.CursorPos); - frmPoint.x:= frmPoint.x + FDelta.x; - frmPoint.y:= frmPoint.y + FDelta.y; - - OldRect := Self.BoundsRect; - AdjL := False; - AdjR := False; - AdjT := False; - AdjB := False; - case FNodes.IndexOf(TWinControl(Sender)) of - 0: begin - //AdjL := True; - //AdjT := True; - end; - 1: begin - //AdjT := True; - end; - 2: begin - //AdjR := True; - //AdjT := True; - end; - 3, 10: begin - AdjR := True; - end; - 4: begin - AdjR := True; - AdjB := True; - end; - 5, 11: begin - AdjB := True; - end; - 6: begin - //AdjL := True; - //AdjB := True; - end; - 7: begin - //AdjL := True; - end; - end; - - if AdjL then - OldRect.Left := frmPoint.X; - if AdjR then - OldRect.Right := frmPoint.X; - if AdjT then - OldRect.Top := frmPoint.Y; - if AdjB then - OldRect.Bottom := frmPoint.Y; - - SetBounds(OldRect.Left,OldRect.Top,OldRect.Right - OldRect.Left,OldRect.Bottom - OldRect.Top); - end; - //move node - Left := Left - FOldPos.X + newPos.X; - Top := Top - FOldPos.Y + newPos.Y; - FOldPos := newPos; - end; - PositionNodes(Self); - if Assigned(OnNodePositioning) then - OnNodePositioning(Self, FPositioningKind, pcPositioning); - - // the same operation as belowe exist in ClientChangeBounds but it is - // disabled for FNodePositioning = true - // we need to refresh this values after OnNodePositioning - FLastClientWidth := pClient.Width; - FLastClientHeight:= pClient.Height; - end; -end; - -procedure TBasicResizeFrame.NodeMouseUp(Sender: TObject; Button: TMouseButton; - Shift: TShiftState; X, Y: Integer); -begin - { TShape in TBasicResizeFrame.CreateNodes is disabled, anyway in future can be usefull - if Sender is TGraphicControl then - Sender := TGraphicControl(Sender).Parent;} - - if FNodePositioning then - begin - Screen.Cursor := crDefault; - {$IF Defined(LCLWin32) or Defined(LCLWin64)} - ReleaseCapture; - {$ENDIF} - - Constraints.MaxWidth := FMaxWidth; - Constraints.MaxHeight := FMaxHeight; - FNodePositioning := False; - ShowSizeControls; - if Assigned(OnNodePositioning) then - OnNodePositioning(Sender, FPositioningKind, pcPositioningEnd); - FPositioningKind := []; - FNodePositioning := False; - - pClient.Align := alNone; - BorderSpacing.Left := 0; - BorderSpacing.Top := 0; - BorderSpacing.Right := 0; - BorderSpacing.Bottom := 0; - PositionNodes(Self); - - EndFormSizeUpdate(Sender); - - // after resizing, TFrame is frozen in Windows OS - // this is trick to workaraund IDE bug. Also for proper size for normal form - TryBoundDesignedForm; - // for small resizes, designed form is moved on the top and on the bottom - // is showed white block - to stop this we need to move pClient to right position - PositionNodes; - ShowSizeControls; - end; -end; - -procedure TBasicResizeFrame.OnModified; -begin - FDesignerModified := True; -end; - -function TBasicResizeFrame.GetRightMargin: Integer; -begin - if not FNodePositioning then - FLastRightMarign := Width - (pR.Left + pR.Width); - Result := FLastRightMarign; -end; - -function TBasicResizeFrame.HasMainMenu: Boolean; -var - I: Integer; -begin - Result := False; - if (FDesignedForm<>nil) and (FDesignedForm.Form.Menu<>nil) - and not (csDestroying in FDesignedForm.Form.Menu.ComponentState) - and (FDesignedForm.Form.Menu.Items.Count>0) - then - for I := 0 to FDesignedForm.Form.Menu.Items.Count-1 do - if FDesignedForm.Form.Menu.Items[I].Visible then - Exit(True); -end; - -function TBasicResizeFrame.GetBottomMargin: Integer; -begin - if not FNodePositioning then - FLastBottomMarign := Height - (pB.Top + pB.Height); - Result := FLastBottomMarign; -end; - -{----------------------------------------------------------------------------------------------------------------------- - for Vertical scroll -{----------------------------------------------------------------------------------------------------------------------} - -function TBasicResizeFrame.BottomSizerRectHeight: Integer; -begin - Result := SizerRectSize; -end; - -function TBasicResizeFrame.BottomSizerLineWidth: Integer; -begin - Result := SizerLineWidth; -end; - -function TBasicResizeFrame.TopSizerRectTop: Integer; -begin - Result := -FVerticalScrollPos; -end; - -function TBasicResizeFrame.TopSizerLineWidth: Integer; -begin - Result := SizerLineWidth; -end; - -function TBasicResizeFrame.VerticalSizerLineLength: Integer; -begin - Result := Height - BottomMargin; -end; - -{----------------------------------------------------------------------------------------------------------------------- - for Horizontal scroll -{----------------------------------------------------------------------------------------------------------------------} - -function TBasicResizeFrame.RightSizerRectWidth: Integer; -begin - Result := SizerRectSize; -end; - -function TBasicResizeFrame.RightSizerLineWidth: Integer; -begin - Result := SizerLineWidth; -end; - -function TBasicResizeFrame.LeftSizerRectLeft: Integer; -begin - Result := -FHorizontalScrollPos; -end; - -function TBasicResizeFrame.LeftSizerLineWidth: Integer; -begin - Result := SizerLineWidth; -end; - -function TBasicResizeFrame.HorizontalSizerLineLength: Integer; -begin - Result := Width - RightMargin; -end; - -procedure TBasicResizeFrame.AdjustFormHandler; -begin - pFormHandler.Left:=(-FDesignedForm.Form.Left)-(FDesignedForm.PositionDelta.x+ifthen(FHorizontalScrollPos-SizerLineWidth>0,FHorizontalScrollPos-SizerLineWidth,0)); - pFormHandler.Top:=(-FDesignedForm.Form.Top)-(FDesignedForm.PositionDelta.y+ifthen(FVerticalScrollPos-SizerLineWidth>0,FVerticalScrollPos-SizerLineWidth,0)); - pFormHandler.Width:=(FDesignedForm.Form.Width+abs(FDesignedForm.Form.Left)+FDesignedForm.PositionDelta.x);; - pFormHandler.Height:=(FDesignedForm.Form.Height+abs(FDesignedForm.Form.Top)+FDesignedForm.PositionDelta.y); -end; - -function TBasicResizeFrame.GetBackgroundMargin(const AIndex: Integer): Integer; -begin - if FBackground = nil then - Result := 0 - else - Result := FBackground.GetMargin(AIndex); - - if (AIndex = 1) and HasMainMenu then - Result := Result + GetMenuHeight; -end; - -function TBasicResizeFrame.GetNewSize: TPoint; -begin - Result := TPoint.Create(FLastClientWidth,FLastClientHeight); -end; - -function TBasicResizeFrame.GetFormHandler: TPanel; -begin - Result := pFormHandler; -end; - -function TBasicResizeFrame.GetNodePositioning: Boolean; -begin - Result := FNodePositioning; -end; - -function TBasicResizeFrame.GetDesignedForm: IDesignedForm; -begin - Result := FDesignedForm; -end; - -procedure TBasicResizeFrame.SetDesignedForm(const AValue: IDesignedForm); -begin - FDesignedForm := AValue; - if FDesignedForm = nil then - begin - if Assigned(FBackground) then - FBackground.ResizeFrame := nil; - FBackground := nil; - end - else - if Supports(FDesignedForm, IDesignedFormBackground, FBackground) then - begin - FBackground.Parent := pBG; - FBackground.ResizeFrame := Self; - end; - // special for QT (at start "design form" has wrong position) - TryBoundDesignedForm; -end; - -function TBasicResizeFrame.GetMenuHeight: Integer; -begin - // some WS (Gtk2) return too big SM_CYMENU, just set it according to font height - // no problem, it is used only for the fake main menu - - {$IFDEF LCLWin32} - Result := lclintf.GetSystemMetrics(SM_CYMENU); - {$ELSE} - if pBG.HandleAllocated then - Result := pBG.Canvas.TextHeight('Hg') * 4 div 3 - else - Result := 20; - {$ENDIF} -end; - -procedure TBasicResizeFrame.TryBoundDesignedForm; -begin - if DesignedForm = nil then - Exit; - - HideSizeControls; - ShowSizeControls; - - // for GTK2 resizing form (pClient is hidden under pBG) - {$IF DEFINED(LCLGtk2) OR DEFINED(LCLQt) OR DEFINED(LCLQt5)} - pFormHandler.SendToBack; // <--- this is a must. - {$ENDIF} - pFormHandler.BringToFront; - - pFakeMenu.Visible := HasMainMenu; - if pFakeMenu.Visible then - begin - pFakeMenu.Height := GetMenuHeight; - pFakeMenu.BorderSpacing.Left := BgLeftMargin; - pFakeMenu.BorderSpacing.Top := BgTopMargin - pFakeMenu.Height; - pFakeMenu.BorderSpacing.Right := BgRightMargin; - pFakeMenu.BringToFront; - end; -end; - -procedure TBasicResizeFrame.BeginFormSizeUpdate(Sender: TObject); -begin - FLastDesignedWidthToScroll:=DesignedWidthToScroll; - FLastDesignedHeightToScroll:=DesignedHeightToScroll; - pBG.OnPaint := nil; - pBG.SendToBack; - FDesignedForm.BeginUpdate; -end; - -procedure TBasicResizeFrame.EndFormSizeUpdate(Sender: TObject); -begin - FDesignedForm.EndUpdate; - pBG.OnPaint := pBGPaint; -end; - -function TBasicResizeFrame.GetFrame: TCustomFrame; -begin - Result := Self; -end; - -function TBasicResizeFrame.GetVerticalScrollPos: Integer; -begin - Result := FVerticalScrollPos; -end; - -procedure TBasicResizeFrame.SetVerticalScrollPos(AValue: Integer); -begin - FVerticalScrollPos := AValue; -end; - -function TBasicResizeFrame.GetHorizontalScrollPos: Integer; -begin - Result := FHorizontalScrollPos; -end; - -procedure TBasicResizeFrame.SetHorizontalScrollPos(AValue: Integer); -begin - FHorizontalScrollPos := AValue; -end; - -function TBasicResizeFrame.GetSizerRectSize: Integer; -begin - Result := SizerRectSize; -end; - -function TBasicResizeFrame.GetSizerLineWidth: Integer; -begin - Result := SizerLineWidth; -end; - -function TBasicResizeFrame.GetBackgroundPanel: TPanel; -begin - Result := pBG; -end; - -function TBasicResizeFrame.DesignedWidthToScroll: Integer; -begin - if DesignedForm = nil then - Exit(0); - if FNodePositioning then - Result := FLastDesignedWidthToScroll - else - Result := abs(DesignedForm.Width - FLastClientWidth); - //Result := DesignedForm.Width - DesignedForm.RealWidth; -end; - -procedure TBasicResizeFrame.DesignerSetFocus; -begin - if FFakeFocusControl.CanSetFocus then - FFakeFocusControl.SetFocus; -end; - -function TBasicResizeFrame.DesignedHeightToScroll: Integer; -begin - if DesignedForm = nil then - Exit(0); - - if FNodePositioning then - Result := FLastDesignedHeightToScroll - else - Result := abs(DesignedForm.Height - FLastClientHeight); - //Result := DesignedForm.Height - DesignedForm.RealHeight; -end; - -procedure TBasicResizeFrame.ClientChangeBounds; -begin - ClientChangeBounds(nil); -end; - -{} - -constructor TBasicResizeFrame.Create(TheOwner: TComponent); -begin - inherited Create(TheOwner); - -// Michl: Don't change DesignTimePPI of BasicResizeFrame (sparta_basicresizeframe.lfm). -// There always has to be the default (none entry = 96 PPI) value! - FSizerRectSize := ScaleX(SIZER_RECT_SIZE, 96); - FSizerLineWidth := ScaleX(SIZER_LINE_WIDTH, 96); - - FFakeFocusControl := TEdit.Create(Self); - FFakeFocusControl.Parent := Self; - FFakeFocusControl.Top := -100; - FFakeFocusControl.OnKeyDown := FakeKeyDown; - FFakeFocusControl.OnKeyUp := FakeKeyUp; - FFakeFocusControl.OnUTF8KeyPress := FakeUTF8KeyPress; - FFakeFocusControl.OnEnter := FakeExitEnter; - FFakeFocusControl.OnExit := FakeExitEnter; - - FNodes := TObjectList.Create(False); - CreateNodes; - - pL.OnPaint := PanelPaint; - pT.OnPaint := PanelPaint; - pR.OnPaint := PanelPaint; - pB.OnPaint := PanelPaint; - - pClient.OnChangeBounds := ClientChangeBounds; - pBG.OnChangeBounds := BGChangeBounds; - PositionNodes(Self); - - Application.AddOnIdleHandler(AppOnIdle); -end; - -procedure TBasicResizeFrame.AppOnIdle(Sender: TObject; var Done: Boolean); -var - aHasMainMenu: Boolean; -begin - if FDesignerModified then - begin - aHasMainMenu := HasMainMenu; - if aHasMainMenu <> FOldHasMainMenu then - begin - FOldHasMainMenu := aHasMainMenu; - TryBoundDesignedForm; - if Assigned(OnNodePositioning) then - OnNodePositioning(Self, [pkBottom], pcPositioningEnd); - Application.NotifyUserInputHandler(Self, 0); // force repaint invisible components - end else - if pFakeMenu.Visible then - pFakeMenu.Invalidate; // always repaint menu on modification - - FDesignerModified := False; - end; -end; - -destructor TBasicResizeFrame.Destroy; -begin - Pointer(FDesignedForm) := nil; - Pointer(FBackground) := nil; - Application.RemoveOnIdleHandler(AppOnIdle); - FNodes.Free; - inherited Destroy; -end; - -procedure TBasicResizeFrame.FakeExitEnter(Sender: TObject); -begin - pL.Repaint; - pT.Repaint; - pR.Repaint; - pB.Repaint; -end; - -procedure TBasicResizeFrame.FakeKeyDown(Sender: TObject; var Key: Word; - Shift: TShiftState); -var - LWndProc: TWndMethod; - LMsg: TLMKeyUp; -begin - LWndProc := FDesignedForm.Form.WindowProc; - FillChar(LMsg{%H-}, SizeOf(LMsg), 0); - LMsg.msg := CN_KEYDOWN; - LMsg.CharCode := Key; - LWndProc(TLMessage(LMsg)); - Key := LMsg.CharCode; -end; - -procedure TBasicResizeFrame.FakeKeyUp(Sender: TObject; var Key: Word; - Shift: TShiftState); -var - LWndProc: TWndMethod; - LMsg: TLMKeyUp; -begin - LWndProc := FDesignedForm.Form.WindowProc; - FillChar(LMsg{%H-}, SizeOf(LMsg), 0); - LMsg.msg := CN_KEYUP; - LMsg.CharCode := Key; - LWndProc(TLMessage(LMsg)); - Key := LMsg.CharCode; -end; - -procedure TBasicResizeFrame.FakeUTF8KeyPress(Sender: TObject; var UTF8Key: TUTF8Char - ); -begin - FDesignedForm.Form.IntfUTF8KeyPress(UTF8Key, 1, False); -end; - -procedure TBasicResizeFrame.PositionNodes(AroundControl: TWinControl); -var - Node,T,L,CT,CL,FR,FB,FT,FL: Integer; - TopLeft: TPoint; -begin - if FDesignedForm = nil then - Exit; - - // positions of bars - if not FNodePositioning then - begin - pL.Left := -FHorizontalScrollPos; - pR.Left := FDesignedForm.Width - FHorizontalScrollPos + pL.Width + BgRightMargin + BgLeftMargin; - pT.Top := -FVerticalScrollPos; - pB.Top := FDesignedForm.Height - FVerticalScrollPos + pT.Height + BgBottomMargin + BgTopMargin; - - // width and height - pL.Top:=0; - pL.Height := FDesignedForm.Height + 2*SizerRectSize + BgTopMargin + BgBottomMargin; - pR.Top:=0; - pR.Height := FDesignedForm.Height + 2*SizerRectSize + BgTopMargin + BgBottomMargin; - pT.Left:=0; - pT.Width := FDesignedForm.Width + 2*SizerRectSize + BgLeftMargin + BgRightMargin; - pB.Left:=0; - pB.Width := FDesignedForm.Width + 2*SizerRectSize + BgLeftMargin + BgRightMargin; - - // client - if pBG.Left + BgLeftMargin <= 0 then - pClient.Left := -(pBG.Left) - (FHorizontalScrollPos - SizerRectSize) - else - pClient.Left := pBG.Left + BgLeftMargin; - if pBG.Top + BgTopMargin <= 0 then - pClient.Top := -(pBG.Top) - (FVerticalScrollPos - SizerRectSize) - else - pClient.Top := pBG.Top + BgTopMargin; - - pClient.Height := Height - pClient.Top - Max(Height - (pB.Top - BgBottomMargin), 0); - pClient.Width := Width - pClient.Left - Max(Width - (pR.Left - BgRightMargin), 0); - end; - - AdjustFormHandler; - - for Node := 0 to 7 do - begin - with AroundControl do - begin - FR := Width - RightSizerRectWidth - RightMargin; - FB := Height - BottomSizerRectHeight - BottomMargin; - - FT := TopSizerRectTop; - FL := LeftSizerRectLeft; - - CL := (FR - FL) div 2 + FL; - CT := (FB - FT) div 2 + FT; - - case Node of - 0: begin - T := FT; - L := FL; - end; - 1: begin - T := FT; - L := CL; - end; - 2: begin - T := FT; - L := FR; - end; - 3: begin - T := CT; - L := FR; - end; - 4: begin - T := FB; - L := FR; - end; - 5: begin - T := FB; - L := CL; - end; - 6: begin - T := FB; - L := FL; - end; - 7: begin - T := CT; - L := FL; - end; - else - T := 0; - L := 0; - end; - - TopLeft := (Classes.Point(L,T)); - end; - with TPanel(FNodes[Node]) do - begin - Top := TopLeft.Y; - Left := TopLeft.X; - Repaint; - end; - end; -end; - -end. - diff --git a/components/sparta/mdi/source/sparta_basicresizer.pas b/components/sparta/mdi/source/sparta_basicresizer.pas deleted file mode 100644 index f0430fefbf..0000000000 --- a/components/sparta/mdi/source/sparta_basicresizer.pas +++ /dev/null @@ -1,152 +0,0 @@ -unit sparta_BasicResizer; - -{$mode delphi}{$H+} - -interface - -uses - Classes, SysUtils, - LCLType, Controls, ExtCtrls, Forms, StdCtrls, Buttons, Dialogs, - sparta_BasicResizeFrame, sparta_InterfacesMDI, sparta_AbstractResizer; - -type - - { TBasicResizer } - - TBasicResizer = class(TAbstractResizer) - private - FDesignedForm: IDesignedForm; - FResizerFrame: TBasicResizeFrame; - protected - function GetActiveResizeFrame: IResizeFrame; override; - function GetActiveDesignedForm: IDesignedForm; override; - procedure SetDesignedForm(const AValue: IDesignedForm); virtual; - public - constructor Create(AParent: TWinControl; AResizerFrameClass: TResizerFrameClass); override; - destructor Destroy; override; - //procedure TryBoundSizerToDesignedForm(Sender: TObject); override; - - property DesignedForm: IDesignedForm read FDesignedForm write SetDesignedForm; - end; - -implementation - -{ TBasicResizer } - -procedure TBasicResizer.SetDesignedForm(const AValue: IDesignedForm); - - function FindFirstFormParent: TCustomForm; - begin - Result := TCustomForm(FResizerFrame.Parent); - while not (Result is TCustomForm) do - Result := TCustomForm(Result.Parent); - end; - -begin - if FDesignedForm <> nil then - FDesignedForm.OnChangeHackedBounds := nil; - FDesignedForm := AValue; - if FDesignedForm <> nil then - begin - FDesignedForm.BeginUpdate; - FDesignedForm.Form.Parent := FResizerFrame.pFormHandler; - // for big forms (bigger than screen resolution) we need to refresh Real* values - DesignedForm.RealWidth := DesignedForm.Width; - DesignedForm.RealHeight := DesignedForm.Height; - - FDesignedForm.EndUpdate; - FDesignedForm.OnChangeHackedBounds := TryBoundSizerToDesignedForm; - end; - FResizerFrame.DesignedForm := AValue; -end; - -constructor TBasicResizer.Create(AParent: TWinControl; - AResizerFrameClass: TResizerFrameClass); -begin - inherited Create(AParent, AResizerFrameClass); - FResizerFrame := CreateResizeFrame; -end; - -destructor TBasicResizer.Destroy; -begin - Pointer(FDesignedForm) := nil; - inherited Destroy; -end; - -(*procedure TBasicResizer.TryBoundSizerToDesignedForm(Sender: TObject); -var - LWidth, LHeight: Integer; - LScrollPos: Integer; -begin - if DesignedForm = nil then - Exit; - - FResizerFrame.Constraints.MaxWidth := pMain.Width; - FResizerFrame.Constraints.MaxHeight := pMain.Height; - - LWidth := DesignedForm.Width + FResizerFrame.BgLeftMargin + FResizerFrame.BgRightMargin + 2*FResizerFrame.SizerRectSize; - LHeight := DesignedForm.Height + FResizerFrame.BgTopMargin + FResizerFrame.BgBottomMargin + 2*FResizerFrame.SizerRectSize; - if not FResizerFrame.NodePositioning then - begin - FResizerFrame.Width := LWidth; - FResizerFrame.Height := LHeight; - // after enlargement and after reducing constrait not work for frame (LCL bug) - if FResizerFrame.Width > FResizerFrame.Constraints.MaxWidth then - FResizerFrame.Width := FResizerFrame.Constraints.MaxWidth; - if FResizerFrame.Height > FResizerFrame.Constraints.MaxHeight then - FResizerFrame.Height := FResizerFrame.Constraints.MaxHeight; - end; - - FResizerFrame.PositionNodes(FResizerFrame); - - DesignScrollBottom := FResizerFrame.Width < LWidth; - sbH.Max := LWidth; - FRealMaxH := LWidth - FResizerFrame.Width; - sbH.PageSize := FResizerFrame.Width; - if FResizerFrame.HorizontalScrollPos > FRealMaxH then - begin - FResizerFrame.HorizontalScrollPos := FRealMaxH; - LScrollPos := FResizerFrame.HorizontalScrollPos; - sbScroll(sbH, scEndScroll, LScrollPos); - end; - - DesignScrollRight := FResizerFrame.Height < LHeight; - sbV.Max := LHeight; - FRealMaxV := LHeight - FResizerFrame.Height; - sbV.PageSize := FResizerFrame.Height; - if FResizerFrame.VerticalScrollPos > FRealMaxV then - begin - FResizerFrame.VerticalScrollPos := FRealMaxV; - LScrollPos := FResizerFrame.VerticalScrollPos; - sbScroll(sbV, scEndScroll, LScrollPos); - end; - - {!} - FResizerFrame.ClientChangeBounds(nil); - - // each editor can have scrolls in different positions. - // this is our place where we can call event to set scroll positions. - LScrollPos := FResizerFrame.VerticalScrollPos; - sbScroll(sbV, scEndScroll, LScrollPos); - LScrollPos := FResizerFrame.HorizontalScrollPos; - sbScroll(sbH, scEndScroll, LScrollPos); - - if Supports(FDesignedForm, IDesignedFormBackground) then - (FDesignedForm as IDesignedFormBackground).RefreshValues; - - FResizerFrame.DesignerSetFocus; -end;*) - -function TBasicResizer.GetActiveResizeFrame: IResizeFrame; -begin - Result := FResizerFrame; -end; - -function TBasicResizer.GetActiveDesignedForm: IDesignedForm; -begin - Result := FDesignedForm; -end; - - -end. - diff --git a/components/sparta/mdi/source/sparta_formbackgroundformdi.lfm b/components/sparta/mdi/source/sparta_formbackgroundformdi.lfm deleted file mode 100644 index dd71f87256..0000000000 --- a/components/sparta/mdi/source/sparta_formbackgroundformdi.lfm +++ /dev/null @@ -1,27 +0,0 @@ -object frFormBackgroundForMDI: TfrFormBackgroundForMDI - Left = 0 - Height = 582 - Top = 0 - Width = 570 - Align = alClient - ClientHeight = 582 - ClientWidth = 570 - Color = clBtnFace - ParentColor = False - TabOrder = 0 - object Panel1: TPanel - Left = 0 - Height = 582 - Top = 0 - Width = 570 - Align = alClient - BevelOuter = bvNone - Caption = 'Panel1' - Color = clOlive - ParentColor = False - TabOrder = 0 - OnMouseDown = Panel1MouseDown - OnMouseMove = Panel1MouseMove - OnMouseUp = Panel1MouseUp - end -end diff --git a/components/sparta/mdi/source/sparta_formbackgroundformdi.pas b/components/sparta/mdi/source/sparta_formbackgroundformdi.pas deleted file mode 100644 index 11ea79a744..0000000000 --- a/components/sparta/mdi/source/sparta_formbackgroundformdi.pas +++ /dev/null @@ -1,133 +0,0 @@ -unit sparta_FormBackgroundForMDI; - -{$mode objfpc}{$H+} -interface - -uses - Classes, SysUtils, FileUtil, Forms, Controls, StdCtrls, ExtCtrls, - sparta_InterfacesMDI; - -type - - { TfrFormBackgroundForMDI } - - TfrFormBackgroundForMDI = class(TFrame, IDesignedFormBackground) - Panel1: TPanel; - procedure Panel1MouseDown(Sender: TObject; {%H-}Button: TMouseButton; - {%H-}Shift: TShiftState; {%H-}X, {%H-}Y: Integer); - procedure Panel1MouseMove(Sender: TObject; {%H-}Shift: TShiftState; {%H-}X, {%H-}Y: Integer - ); - procedure Panel1MouseUp(Sender: TObject; {%H-}Button: TMouseButton; - {%H-}Shift: TShiftState; {%H-}X, {%H-}Y: Integer); - private - FDesignedForm: IDesignedForm; - FResizeFrame: IResizeFrame; - FDelta: TPoint; - FDown: Boolean; - - function GetMargin(const AIndex: Integer): Integer; - protected - function GetParent: TWinControl; virtual; - procedure SetParent(AParent: TWinControl); override; - function GetResizeFrame: IResizeFrame; - procedure SetResizeFrame(AValue: IResizeFrame); - - function GetDesignedForm: IDesignedForm; - public - { public declarations } - constructor Create(const ADesignedForm: IDesignedForm); virtual; reintroduce; - - procedure RefreshValues; - end; - -implementation - -{$R *.lfm} - -{ TfrFormBackgroundForMDI } - -procedure TfrFormBackgroundForMDI.Panel1MouseDown(Sender: TObject; - Button: TMouseButton; Shift: TShiftState; X, Y: Integer); -var - LCtrlPoint: TPoint; -begin - LCtrlPoint := Panel1.ScreenToClient(Mouse.CursorPos); - FDelta.x := -LCtrlPoint.X; - FDelta.y := -LCtrlPoint.Y; - FDown := True; -end; - -procedure TfrFormBackgroundForMDI.Panel1MouseMove(Sender: TObject; - Shift: TShiftState; X, Y: Integer); -var - frmPoint: TPoint; - LFrame: TCustomFrame; -begin - if (not FDown) or (FResizeFrame = nil) then - Exit; - - frmPoint := Self.ScreenToClient(Mouse.CursorPos); - LFrame := FResizeFrame.Frame; - LFrame.Left := LFrame.Left + (frmPoint.x + FDelta.x); - LFrame.Top := LFrame.Top + (frmPoint.y + FDelta.y); -end; - -procedure TfrFormBackgroundForMDI.Panel1MouseUp(Sender: TObject; - Button: TMouseButton; Shift: TShiftState; X, Y: Integer); -begin - FDown := False; -end; - -function TfrFormBackgroundForMDI.GetMargin(const AIndex: Integer): Integer; -begin - case AIndex of - 0: // left - Result := 5; - 1: // Top - Result := 30; - 2: // Right - Result := 5; - 3: // Bottom - Result := 5; - end; -end; - -function TfrFormBackgroundForMDI.GetParent: TWinControl; -begin - Result := inherited Parent; -end; - -procedure TfrFormBackgroundForMDI.SetParent(AParent: TWinControl); -begin - inherited SetParent(AParent); -end; - -function TfrFormBackgroundForMDI.GetResizeFrame: IResizeFrame; -begin - Result := FResizeFrame; -end; - -procedure TfrFormBackgroundForMDI.SetResizeFrame(AValue: IResizeFrame); -begin - FResizeFrame := AValue; -end; - -function TfrFormBackgroundForMDI.GetDesignedForm: IDesignedForm; -begin - Result := FDesignedForm as IDesignedForm; -end; - -constructor TfrFormBackgroundForMDI.Create(const ADesignedForm: IDesignedForm); -begin - inherited Create(nil); - FDesignedForm := ADesignedForm; - RefreshValues; -end; - -procedure TfrFormBackgroundForMDI.RefreshValues; -begin - -end; - -end. - diff --git a/components/sparta/mdi/source/sparta_interfacesmdi.pas b/components/sparta/mdi/source/sparta_interfacesmdi.pas deleted file mode 100644 index da3597b3f9..0000000000 --- a/components/sparta/mdi/source/sparta_interfacesmdi.pas +++ /dev/null @@ -1,171 +0,0 @@ -unit sparta_InterfacesMDI; - -{$WARNING Package Sparta_MDI is deprecated} -{$WARNING It will be removed from Lazarus sources in next major release} -{$mode objfpc}{$H+} - -interface - -uses - Classes, SysUtils, Controls, Forms, ExtCtrls; - -type - IDesignedRealForm = interface - ['{AAEC32EE-4ABE-4691-A172-FC67B66118DD}'] - // bounds - function GetRealBounds(AIndex: Integer): Integer; - procedure SetRealBounds(AIndex: Integer; AValue: Integer); - - property RealLeft: Integer index 0 read GetRealBounds write SetRealBounds; - property RealTop: Integer index 1 read GetRealBounds write SetRealBounds; - property RealWidth: Integer index 2 read GetRealBounds write SetRealBounds; - property RealHeight: Integer index 3 read GetRealBounds write SetRealBounds; - - // setters - procedure SetRealBorderStyle(AVal: TFormBorderStyle); - procedure SetRealBorderIcons(AVal: TBorderIcons); - procedure SetRealFormStyle(AVal: TFormStyle); - procedure SetRealPopupMode(AVal: TPopupMode); - procedure SetRealPopupParent(AVal: TCustomForm); - - // getters - function GetRealBorderStyle: TFormBorderStyle; - function GetRealBorderIcons: TBorderIcons; - function GetRealFormStyle: TFormStyle; - function GetRealPopupMode: TPopupMode; - function GetRealPopupParent: TCustomForm; - - // properties - property RealBorderStyle: TFormBorderStyle read GetRealBorderStyle write SetRealBorderStyle; - property RealBorderIcons: TBorderIcons read GetRealBorderIcons write SetRealBorderIcons; - property RealFormStyle: TFormStyle read GetRealFormStyle write SetRealFormStyle; - - property RealPopupMode: TPopupMode read GetRealPopupMode write SetRealPopupMode; - property RealPopupParent: TCustomForm read GetRealPopupParent write SetRealPopupParent; - end; - - IDesignedForm = interface(IDesignedRealForm) - ['{5D30C0DE-4D51-4FB5-99FC-88900FAE6B66}'] - procedure BeginUpdate; - procedure EndUpdate(AModified: Boolean = False); - - function GetUpdate: Boolean; - property Update: Boolean read GetUpdate; - - procedure ShowWindow; - procedure HideWindow; - function PositionDelta: TPoint; - - // hacked values - function GetPublishedBounds(AIndex: Integer): Integer; - procedure SetPublishedBounds(AIndex: Integer; AValue: Integer); - property Left: Integer index 0 read GetPublishedBounds write SetPublishedBounds; - property Top: Integer index 1 read GetPublishedBounds write SetPublishedBounds; - property Width: Integer index 2 read GetPublishedBounds write SetPublishedBounds; - property Height: Integer index 3 read GetPublishedBounds write SetPublishedBounds; - - // design form scroll system - procedure SetHorzScrollPosition(AValue: Integer); - procedure SetVertScrollPosition(AValue: Integer); - function GetHorzScrollPosition: Integer; - function GetVertScrollPosition: Integer; - property HorzScrollPosition: Integer read GetHorzScrollPosition write SetHorzScrollPosition; - property VertScrollPosition: Integer read GetVertScrollPosition write SetVertScrollPosition; - - // on notify change - procedure SetOnChangeHackedBounds(const AValue: TNotifyEvent); - function GetOnChangeHackedBounds: TNotifyEvent; - property OnChangeHackedBounds: TNotifyEvent read GetOnChangeHackedBounds write SetOnChangeHackedBounds; - - // - function GetForm: TCustomForm; - property Form: TCustomForm read GetForm; - end; - - IDesignedRealFormHelper = interface(IDesignedRealForm) - ['{7EF20246-A8B4-4919-8C33-20E07C24F0E9}'] - function GetLogicalClientRect(ALogicalClientRect: TRect): TRect; - end; - - IResizeFrame = interface - ['{A674B2AF-4984-433D-8872-5B5825F345D7}'] - procedure HideSizeRects; - procedure ShowSizeRects; - procedure PositionNodes; - function DesignedWidthToScroll: Integer; - function DesignedHeightToScroll: Integer; - procedure ClientChangeBounds; - procedure DesignerSetFocus; - procedure OnModified; - - function GetFrame: TCustomFrame; - function GetVerticalScrollPos: Integer; - procedure SetVerticalScrollPos(AValue: Integer); - function GetHorizontalScrollPos: Integer; - procedure SetHorizontalScrollPos(AValue: Integer); - function GetBackgroundPanel: TPanel; - function GetBackgroundMargin(const AIndex: Integer): Integer; - function GetNewSize: TPoint; - function GetFormHandler: TPanel; - function GetNodePositioning: Boolean; - function GetDesignedForm: IDesignedForm; - procedure SetDesignedForm(const AValue: IDesignedForm); - - function GetSizerRectSize: Integer; - function GetSizerLineWidth: Integer; - - property Frame: TCustomFrame read GetFrame; - property VerticalScrollPos: Integer read GetVerticalScrollPos write SetVerticalScrollPos; - property HorizontalScrollPos: Integer read GetHorizontalScrollPos write SetHorizontalScrollPos; - property BgPanel: TPanel read GetBackgroundPanel; - - property BgLeftMargin: Integer index 0 read GetBackgroundMargin; - property BgTopMargin: Integer index 1 read GetBackgroundMargin; - property BgRightMargin: Integer index 2 read GetBackgroundMargin; - property BgBottomMargin: Integer index 3 read GetBackgroundMargin; - - property NewSize: TPoint read GetNewSize; - property FormHandler: TPanel read GetFormHandler; - property NodePositioning: Boolean read GetNodePositioning; - property DesignedForm: IDesignedForm read GetDesignedForm write SetDesignedForm; - - property SizerRectSize: Integer read GetSizerRectSize; - property SizerLineWidth: Integer read GetSizerLineWidth; - end; - - IDesignedFormBackground = interface - ['{AC7F6594-1C2D-4424-977B-28053A79CE99}'] - function GetMargin(const AIndex: Integer): Integer; - - property LeftMargin: Integer index 0 read GetMargin; - property TopMargin: Integer index 1 read GetMargin; - property RightMargin: Integer index 2 read GetMargin; - property BottomMargin: Integer index 3 read GetMargin; - - procedure SetParent(AValue: TWinControl); - function GetParent: TWinControl; - property Parent: TWinControl read GetParent write SetParent; - - function GetDesignedForm: IDesignedForm; - property DesignedForm: IDesignedForm read GetDesignedForm; - - function GetResizeFrame: IResizeFrame; - procedure SetResizeFrame(AValue: IResizeFrame); - property ResizeFrame: IResizeFrame read GetResizeFrame write SetResizeFrame; - - procedure RefreshValues; - end; - - IResizer = interface - ['{C3D1A2C0-8AED-493B-9809-1F5C3A54A8A8}'] - procedure TryBoundSizerToDesignedForm(Sender: TObject); - function GetActiveResizeFrame: IResizeFrame; - property ActiveResizeFrame: IResizeFrame read GetActiveResizeFrame; - function GetActiveDesignedForm: IDesignedForm; - property ActiveDesignedForm: IDesignedForm read GetActiveDesignedForm; - end; - -implementation - -end. - diff --git a/components/sparta/mdi/source/sparta_multiplyresizer.pas b/components/sparta/mdi/source/sparta_multiplyresizer.pas deleted file mode 100644 index 640b6cb0fc..0000000000 --- a/components/sparta/mdi/source/sparta_multiplyresizer.pas +++ /dev/null @@ -1,209 +0,0 @@ -unit sparta_MultiplyResizer; - -{$mode delphi}{$H+} - -interface - -uses - Classes, SysUtils, - Forms, Controls, LMessages, - Generics.Collections, - sparta_AbstractResizer, sparta_InterfacesMDI, sparta_BasicResizeFrame; - -type - - { TMultiplyResizer } - - { TResizerRec } - - TResizerRec = class - public - Frame: TBasicResizeFrame; - Idx: Integer; - constructor Create(AFrame: TBasicResizeFrame); - destructor Destroy; override; - end; - - TMultiplyResizer = class(TAbstractResizer) - private class var - FAllForms: TDictionary; - - class constructor Create; - class destructor Destroy; - - class procedure OnUserInputHandler(Sender: TObject; Msg: Cardinal); - private - FFormsStack: TList; - FForms: TObjectDictionary; - protected - // only allow to set prevously added DesignedForms by AddDesignedForm - //procedure SetDesignedForm(const AValue: IDesignedForm); override; - - procedure RemoveFormEvent(Sender: TObject; Form: TCustomForm); - protected { IResizer } - //procedure TryBoundSizerToDesignedForm(Sender: TObject); override; - function GetActiveResizeFrame: IResizeFrame; override; - function GetActiveDesignedForm: IDesignedForm; override; - public - constructor Create(AParent: TWinControl; AResizerFrameClass: TResizerFrameClass); override; - destructor Destroy; override; - - procedure AddDesignedForm(const AForm: IDesignedForm); - end; - -implementation - -{ TResizerRec } - -constructor TResizerRec.Create(AFrame: TBasicResizeFrame); -begin - Frame := AFrame; -end; - -destructor TResizerRec.Destroy; -begin - //Frame.Free; // free by owner - inherited Destroy; -end; - -{ TMultiplyResizer } - -class constructor TMultiplyResizer.Create; -begin - Application.AddOnUserInputHandler(OnUserInputHandler); - FAllForms := TDictionary.Create; -end; - -class destructor TMultiplyResizer.Destroy; -begin - Application.RemoveOnUserInputHandler(OnUserInputHandler); - FAllForms.Free; -end; - -class procedure TMultiplyResizer.OnUserInputHandler(Sender: TObject; - Msg: Cardinal); -var - LCtrl: TControl; - LActiveFrame: TBasicResizeFrame = nil; - LResizer: TMultiplyResizer = nil; - LResizerRec, LLastResizerRec: TResizerRec; - tmp: Integer; -begin - if (Msg = LM_LBUTTONDOWN) or (Msg = LM_RBUTTONDOWN) or (Msg = LM_MBUTTONDOWN) then - begin - LCtrl := FindDragTarget(Mouse.CursorPos, True); - - // find dedicated TMultiplyResizer and Frame - if LCtrl <> nil then - repeat - if LCtrl is TBasicResizeFrame then - LActiveFrame := TBasicResizeFrame(LCtrl); - - LCtrl := LCtrl.Parent; - if (LCtrl <> nil) and (LCtrl.Owner is TMultiplyResizer) then - begin - LResizer := TMultiplyResizer(LCtrl.Owner); - Break; - end; - until (LCtrl = nil); - - // frame to activate - if Assigned(LActiveFrame) and Assigned(LResizer) then - begin - LResizerRec := LResizer.FForms[LActiveFrame.DesignedForm]; - LLastResizerRec := LResizer.FForms[LResizer.FFormsStack.Last]; - // already on top - if LResizerRec = LLastResizerRec then - Exit; - - LResizer.FFormsStack.Exchange(LResizerRec.Idx, LLastResizerRec.Idx); - tmp := LLastResizerRec.Idx; - LLastResizerRec.Idx := LResizerRec.Idx; - LResizerRec.Idx := tmp; - // show! - LActiveFrame.BringToFront; - end; - end; -end; - -procedure TMultiplyResizer.RemoveFormEvent(Sender: TObject; Form: TCustomForm); -var - LForm: IDesignedForm; -begin - if Supports(Form, IDesignedForm, LForm) then - begin - FFormsStack.Remove(LForm); - FForms.Remove(LForm); - end; -end; - -function TMultiplyResizer.GetActiveResizeFrame: IResizeFrame; -var - LForm: IDesignedForm; -begin - LForm := GetActiveDesignedForm; - if LForm = nil then - Result := nil - else - Result := FForms[LForm].Frame; -end; - -function TMultiplyResizer.GetActiveDesignedForm: IDesignedForm; -begin - if FFormsStack.Count = 0 then - Result := nil - else - Result := FFormsStack.Last; -end; - -constructor TMultiplyResizer.Create(AParent: TWinControl; - AResizerFrameClass: TResizerFrameClass); -begin - inherited Create(AParent, AResizerFrameClass); - FForms := TObjectDictionary.Create([doOwnsValues]); - FFormsStack := TList.Create; -end; - -destructor TMultiplyResizer.Destroy; -begin - FFormsStack.Free; - FForms.Free; - inherited Destroy; -end; - -procedure TMultiplyResizer.AddDesignedForm(const AForm: IDesignedForm); -var - LFrame: TBasicResizeFrame; - LResizerRec: TResizerRec; -begin - if AForm = nil then - Exit; - - LFrame := CreateResizeFrame; - - AForm.BeginUpdate; - - AForm.Form.Parent := LFrame.pClient; - {$IFNDEF WINDOWS} - AForm.Form.BorderStyle := bsNone; - {$ENDIF} - // for big forms (bigger than screen resolution) we need to refresh Real* values - AForm.RealWidth := AForm.Width; - AForm.RealHeight := AForm.Height; - - AForm.EndUpdate; - AForm.OnChangeHackedBounds := TryBoundSizerToDesignedForm; - - LFrame.DesignedForm := AForm; - - LResizerRec := TResizerRec.Create(LFrame); - FForms.Add(AForm, LResizerRec); - LResizerRec.Idx := FFormsStack.Add(AForm); - - // when form is removed we need to remove all handlers located in FFormsStack - // and FForms - Screen.AddHandlerRemoveForm(RemoveFormEvent); -end; - -end. - diff --git a/components/sparta/mdi/sparta_mdi.lpk b/components/sparta/mdi/sparta_mdi.lpk deleted file mode 100644 index 463cc5ad79..0000000000 --- a/components/sparta/mdi/sparta_mdi.lpk +++ /dev/null @@ -1,64 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/components/sparta/mdi/sparta_mdi.pas b/components/sparta/mdi/sparta_mdi.pas deleted file mode 100644 index 2adfc9bce4..0000000000 --- a/components/sparta/mdi/sparta_mdi.pas +++ /dev/null @@ -1,22 +0,0 @@ -{ This file was automatically created by Lazarus. Do not edit! - This source is only used to compile and install the package. - } - -unit sparta_MDI; - -interface - -uses - sparta_BasicResizeFrame, sparta_InterfacesMDI, sparta_BasicResizer, - sparta_MDI_StrConsts, sparta_BasicFakeCustom, sparta_FormBackgroundForMDI, - sparta_MultiplyResizer, sparta_AbstractResizer, LazarusPackageIntf; - -implementation - -procedure Register; -begin -end; - -initialization - RegisterPackage('sparta_MDI', @Register); -end. diff --git a/components/sparta/mdi/sparta_mdi_strconsts.pas b/components/sparta/mdi/sparta_mdi_strconsts.pas deleted file mode 100644 index 9ce7498c0a..0000000000 --- a/components/sparta/mdi/sparta_mdi_strconsts.pas +++ /dev/null @@ -1,13 +0,0 @@ -unit sparta_MDI_StrConsts; - -{$mode objfpc}{$H+} - -interface - -resourcestring - SArgumentOutOfRange = 'Argument out of range'; - -implementation - -end. - diff --git a/components/sparta/smartformeditor/source/sparta.res b/components/sparta/smartformeditor/source/sparta.res deleted file mode 100644 index 46d2b90436..0000000000 Binary files a/components/sparta/smartformeditor/source/sparta.res and /dev/null differ diff --git a/components/sparta/smartformeditor/source/sparta_componentpalette.pas b/components/sparta/smartformeditor/source/sparta_componentpalette.pas deleted file mode 100644 index 1a51d4dbad..0000000000 --- a/components/sparta/smartformeditor/source/sparta_componentpalette.pas +++ /dev/null @@ -1,619 +0,0 @@ -{ - ***************************************************************************** - See the file COPYING.modifiedLGPL.txt, included in this distribution, - for details about the license. - ***************************************************************************** - - Author: Maciej Izak - - DaThoX 2004-2015 - FreeSparta.com -} - -unit sparta_ComponentPalette; - -{$mode delphi}{$H+} - -interface - -uses - Forms, Classes, SysUtils, Math, - // LCL - Controls, ComCtrls, ExtCtrls, Buttons, LResources, LCLType, Graphics, - // LazUtils - LazStringUtils, - Generics.Collections, - // IdeIntf - ComponentReg, LazIDEIntf, PropEdits, FormEditingIntf, IDEImagesIntf; - -type - - { TPageData } - - TPageData = record - FUpDown: TUpDown; - FComponents: TPanel; - FSelectionTool: TSpeedButton; - - constructor Create(AUpDown: TUpDown; AComponents: TPanel; ASelectionTool: TSpeedButton); - end; - - { TComponentsPalette } - - TComponentsPalette = class(TComponent) - private - pcComponents: TPageControl; - FFilter: string; - FRoot: TPersistent; - FPages: TDictionary; - FLastForm: TCustomForm; - FIgnoreRoot: Boolean; - - procedure SetRoot(AValue: TPersistent); - function GetRoot: TPersistent; - - procedure OnComponentClick(Sender: TObject); - procedure OnComponentDblClick(Sender: TObject); - procedure ComponentAdded(ALookupRoot, AComponent: TComponent; ARegisteredComponent: TRegisteredComponent); - - procedure AddComponent(AComponent: TRegisteredComponent); - - procedure OnUpdateIDEComponentPalette(Sender: TObject); - procedure SetFilter(AValue: string); - - - procedure UpDownChangingEx(Sender: TObject; var AllowChange: Boolean; - NewValue: SmallInt; Direction: TUpDownDirection); - procedure pcComponentsResize(Sender: TObject); - procedure pcComponentsChange(Sender: TObject); - procedure ComponentsPageCtrlChange(Sender: TObject); - - procedure RefreshSearchResult; - procedure UpdateComponentsList; - - procedure OnDesignSetSelection(const ASelection: TPersistentSelectionList); - public - constructor Create(AOwner: TComponent; AParent: TWinControl; AIgnoreRoot: Boolean = False); reintroduce; - destructor Destroy; override; - property Root: TPersistent read GetRoot write SetRoot; - property Filter: string read FFilter write SetFilter; - function IsEmpty: Boolean; - end; - -implementation - -{$R sparta.res} - -{ TPageData } - -constructor TPageData.Create(AUpDown: TUpDown; AComponents: TPanel; - ASelectionTool: TSpeedButton); -begin - FUpDown := AUpDown; - FComponents := AComponents; - FSelectionTool := ASelectionTool; -end; - -{ TComponentsPalette } - -procedure TComponentsPalette.SetRoot(AValue: TPersistent); -begin - if FRoot = AValue then - Exit; - FRoot := AValue; - - UpdateComponentsList; -end; - -function TComponentsPalette.GetRoot: TPersistent; -begin - Result := FRoot; -end; - -procedure TComponentsPalette.OnComponentClick(Sender: TObject); -var - LComponent: TRegisteredComponent; - LSender: TSpeedButton absolute Sender; - i: TComponent; - LButton: TSpeedButton absolute i; -begin - // ignore click for dblclick event - if LSender.Owner.Tag = 1 then - begin - LSender.Owner.Tag := 0; - LSender.Down := False; - Exit; - end; - LComponent := TRegisteredComponent(LSender.Tag); - if Assigned(LComponent) then - begin - IDEComponentPalette.SetSelectedComp(LComponent, ssShift in GetKeyShiftState); - // deactivate "Selection tool button" - // all buttons with components AllowAllUp := False and for Selection tool AllowAllUp := True - for i in LSender.Owner do - if i is TSpeedButton then - // trick with LSender.Down for DblClick - if (LButton.Tag <> 0) then - LButton.AllowAllUp := False - else // Selection tool - begin - LButton.AllowAllUp := True; - LButton.Down := False; - end; - end - else - begin - IDEComponentPalette.SetSelectedComp(nil, false); - // deactivate all other buttons than "selection tool button" - for i in LSender.Owner do - if i is TSpeedButton then - if LButton.Tag <> 0 then - begin - LButton.AllowAllUp := True; - LButton.Down := False - end - else // Selection tool - LButton.AllowAllUp := False; - end; -end; - -procedure TComponentsPalette.OnComponentDblClick(Sender: TObject); -var - LSelectionTool: TSpeedButton; - LButton: TSpeedButton absolute Sender; -begin - if not Assigned(pcComponents.ActivePage) then - Exit; - - AddComponent(TRegisteredComponent(LButton.Tag)); - - LSelectionTool := FPages[pcComponents.ActivePage].FSelectionTool; - LSelectionTool.Down := True; - OnComponentClick(LSelectionTool); - LButton.Owner.Tag := 1; // ignore click event -end; - -procedure TComponentsPalette.ComponentAdded(ALookupRoot, - AComponent: TComponent; ARegisteredComponent: TRegisteredComponent); -var - LSelectionTool: TSpeedButton; -begin - if (ALookupRoot <> FRoot) or IDEComponentPalette.MultiSelect or not Assigned(pcComponents.ActivePage) then - Exit; - - LSelectionTool := FPages[pcComponents.ActivePage].FSelectionTool; - - LSelectionTool.Down := True; - OnComponentClick(LSelectionTool); -end; - -procedure TComponentsPalette.AddComponent(AComponent: TRegisteredComponent); -var - LPos: TPoint; - LClass: TComponentClass; - LParent: TComponent; - LNewComponent: TComponent; -begin - if not Assigned(AComponent) or not Assigned(FormEditingHook) or not Assigned(FRoot) then - Exit; - - LClass := AComponent.ComponentClass; - - // form for which was clicked component - this form does not necessarily have to be active... - GlobalDesignHook.LookupRoot := FRoot; - - LParent := FormEditingHook.GetDefaultComponentParent(LClass); - - // default position - if not Assigned(LParent) or not FormEditingHook.GetDefaultComponentPosition(LClass, LParent, LPos.X, LPos.Y) then - exit; - - LNewComponent := FormEditingHook.CreateComponent(LParent, LClass, '', LPos.X, LPos.Y, 0, 0, True); - - if not Assigned(LNewComponent) then - Exit; - - if LNewComponent is TControl then - TControl(LNewComponent).EnableAutoSizing; - GlobalDesignHook.PersistentAdded(LNewComponent, true); -end; - -procedure TComponentsPalette.RefreshSearchResult; -var - i, j: Integer; - LCtrl: TControl; - LPComponents: TPanel; - LButtons: TList; - LVisibleButtons: Integer; - LSearchResult: TTabSheet; - - procedure AddButton(AButton: TSpeedButton); - begin - with TSpeedButton.Create(LSearchResult) do - begin - Glyph.Assign(AButton.Glyph); - Hint := AButton.Hint; - - ShowHint := True; - Flat := True; - GroupIndex := 1; - Constraints.MinWidth:=ComponentPaletteBtnWidth; - Constraints.MinHeight:=ComponentPaletteBtnHeight; - Constraints.MaxWidth:=ComponentPaletteBtnWidth; - Constraints.MaxHeight:=ComponentPaletteBtnHeight; - - Parent := LPComponents; - Tag := AButton.Tag; - OnClick := OnComponentClick; - OnDblClick := OnComponentDblClick; - AllowAllUp := True; - end; - end; - -begin - LSearchResult := pcComponents.Pages[0]; - LSearchResult.TabVisible := FFilter <> ''; - if FFilter = '' then - begin - // show all - for i := 1 to pcComponents.PageCount - 1 do - begin - pcComponents.Pages[i].TabVisible := True; - LPComponents := FPages[pcComponents.Pages[i]].FComponents; - for j := 0 to LPComponents.ControlCount - 1 do - begin - LCtrl := LPComponents.Controls[j]; - LCtrl.Visible := True; - end; - end; - end - // use filter ! - else - begin - LButtons := TList.Create; - for i := 1 to pcComponents.PageCount - 1 do - begin - LPComponents := FPages[pcComponents.Pages[i]].FComponents; - LVisibleButtons := LPComponents.ControlCount; - for j := 0 to LPComponents.ControlCount - 1 do - begin - LCtrl := LPComponents.Controls[j]; - if PosI(FFilter, TRegisteredComponent(LCtrl.Tag).ComponentClass.ClassName) > 0 then - begin - LButtons.Add(LCtrl); - LCtrl.Visible := True; - end - else - begin - Dec(LVisibleButtons); - LCtrl.Visible := False; - end; - end; - - pcComponents.Pages[i].TabVisible := LVisibleButtons > 0; - end; - - // add all buttons to the new page with results - LPComponents := FPages[LSearchResult].FComponents; - for i := LPComponents.ControlCount - 1 downto 0 do - LPComponents.Controls[i].Free; - - for LCtrl in LButtons do - AddButton(TSpeedButton(LCtrl)); - - LButtons.Free; - pcComponents.ActivePageIndex:=0; - end; - pcComponentsResize(nil); -end; - -procedure TComponentsPalette.UpDownChangingEx(Sender: TObject; - var AllowChange: Boolean; NewValue: SmallInt; Direction: TUpDownDirection); -var - LSender: TUpDown absolute Sender; -begin - case Direction of - updUp : LSender.Tag := ifthen(LSender.Tag > 0, LSender.Tag - 1, 0); - updDown: LSender.Tag := LSender.Tag + 1; - end; - - pcComponentsResize(nil); -end; - -procedure TComponentsPalette.pcComponentsResize(Sender: TObject); -var - LPComponents: TPanel; - LUpDown: TUpDown; - LLines: Integer; -begin - if (pcComponents.ActivePage = nil) or (not FPages.ContainsKey(pcComponents.ActivePage)) then - Exit; - - LPComponents := FPages[pcComponents.ActivePage].FComponents; - LUpDown := FPages[pcComponents.ActivePage].FUpDown; - if (LPComponents.ControlCount * ComponentPaletteBtnWidth) < LPComponents.Width then - begin - LUpDown.Visible := False; - LPComponents.ChildSizing.ControlsPerLine := LPComponents.ControlCount; - LPComponents.Top := 0; - Exit; - end; - - LUpDown.Visible := True; - LPComponents.ChildSizing.ControlsPerLine := LPComponents.ClientWidth div ComponentPaletteBtnWidth; - if LPComponents.ChildSizing.ControlsPerLine = 0 then - LPComponents.ChildSizing.ControlsPerLine := 1; - LLines := LPComponents.ControlCount div LPComponents.ChildSizing.ControlsPerLine; - Inc(LLines, ifthen(LPComponents.ControlCount mod LPComponents.ChildSizing.ControlsPerLine <> 0, 1, 0)); - - if LUpDown.Tag >= LLines then - LUpDown.Tag := LLines - 1; - LPComponents.Top := -(LUpDown.Tag * ComponentPaletteBtnHeight); -end; - -procedure TComponentsPalette.pcComponentsChange(Sender: TObject); -var - LComponent: TComponent; - LButton: TSpeedButton absolute LComponent; -begin - pcComponentsResize(nil); - - for LComponent in pcComponents.ActivePage do - if LComponent is TSpeedButton then - if LButton.Tag = 0 then - begin - LButton.Down := True; - IDEComponentPalette.SetSelectedComp(nil, false); - end - else - LButton.Down := False; -end; - -procedure TComponentsPalette.ComponentsPageCtrlChange(Sender: TObject); -var - i: Integer; - pc: TPageControl absolute Sender; - s: string; -begin - s := pc.Pages[pc.PageIndex].Caption; - for i := 0 to pcComponents.PageCount do - if s = pcComponents.Pages[i].Caption then - begin - pcComponents.PageIndex := i; - Exit; - end; -end; - -constructor TComponentsPalette.Create(AOwner: TComponent; AParent: TWinControl; - AIgnoreRoot: Boolean); -begin - inherited Create(AOwner); - - FIgnoreRoot := AIgnoreRoot; - - //if AIgnoreRoot then - // LazarusIDE.AddHandlerOnUpdateComponentPageControl(ComponentsPageCtrlChange); - //LazarusIDE.AddHandlerOnUpdateIDEComponentPalette(OnUpdateIDEComponentPalette); - - IDEComponentPalette.AddHandlerComponentAdded(ComponentAdded); - GlobalDesignHook.AddHandlerSetSelection(OnDesignSetSelection); - - FPages := TDictionary.Create; - - pcComponents := TPageControl.Create(AOwner); - pcComponents.Parent := AParent; - pcComponents.Align:=alClient; - pcComponents.OnResize:=pcComponentsResize; - pcComponents.OnChange:=pcComponentsChange; -end; - -destructor TComponentsPalette.Destroy; -begin - if not FIgnoreRoot then - begin - //LazarusIDE.RemoveHandlerOnUpdateIDEComponentPalette(OnUpdateIDEComponentPalette); - IDEComponentPalette.RemoveHandlerComponentAdded(ComponentAdded); - end; - FPages.Free; - - inherited Destroy; -end; - -function TComponentsPalette.IsEmpty: Boolean; -begin - Result := pcComponents.PageCount = 0; -end; - -procedure TComponentsPalette.OnUpdateIDEComponentPalette(Sender: TObject); -begin - FLastForm := TCustomForm(Sender); - if FIgnoreRoot then - if (Sender <> nil) and (Root = nil) then - Root := LookupRoot(Sender as TCustomForm); - - if (Sender = nil) or (LookupRoot(Sender as TCustomForm) <> FRoot) then - Exit; - - if (IDEComponentPalette.Selected = nil) and Assigned(pcComponents.ActivePage) then - OnComponentClick(FPages[pcComponents.ActivePage].FSelectionTool); -end; - -procedure TComponentsPalette.SetFilter(AValue: string); -begin - if FFilter = AValue then - Exit; - - FFilter := UpperCase(AValue); - RefreshSearchResult; -end; - -procedure TComponentsPalette.UpdateComponentsList; - - procedure CreatePage(const ACaption: string; APage: TBaseComponentPage); - - function LoadIcon(const AClassName: string): TCustomBitmap; - var - LLazResource: TLResource; - begin - Result := nil; - - if FindResource(HINSTANCE, PChar(AClassName), PChar(RT_BITMAP)) <> 0 then - begin - Result := TBitmap.Create; - Result.LoadFromResourceName(HINSTANCE, AClassName); - Result.Transparent := True; - Exit; - end - else - if FindResource(HINSTANCE, PChar(AClassName), PChar(RT_RCDATA)) <> 0 then - Result := CreateBitmapFromResourceName(HINSTANCE, AClassName) - else - begin - LLazResource := LazarusResources.Find(AClassName); - if LLazResource <> nil then - Exit(CreateBitmapFromLazarusResource(LLazResource)); - end; - - if Result = nil then - Exit(CreateBitmapFromResourceName(HINSTANCE, 'default')); - end; - - var - i: Integer; - LPage: TTabSheet; - LUpDown: TUpDown; - LPSelection: TPanel; - LPComponents: TPanel; - LButton: TSpeedButton; - LComponent: TRegisteredComponent; - LClass: TComponentClass; - LIcon: TCustomBitmap; - - begin - LPage := TTabSheet.Create(pcComponents); - LPage.Caption := ACaption; - LPage.PageControl := pcComponents; - - LPSelection := TPanel.Create(LPage); - LPSelection.Width := ComponentPaletteBtnWidth + ComponentPaletteBtnWidth div 2; - LPSelection.Align := alLeft; - LPSelection.ChildSizing.Layout := cclTopToBottomThenLeftToRight; - LPSelection.ChildSizing.ControlsPerLine := 1; - LPSelection.Parent := LPage; - LPSelection.BevelOuter := bvNone; - - LButton := TSpeedButton.Create(LPage); - with LButton do - begin - IDEImages.AssignImage(LButton, 'tmouse'); - Hint := 'Selection tool'; - - ShowHint := True; - Flat := True; - GroupIndex := 1; - Constraints.MinWidth:=ComponentPaletteBtnWidth; - Constraints.MinHeight:=ComponentPaletteBtnHeight; - Constraints.MaxWidth:=ComponentPaletteBtnWidth; - Constraints.MaxHeight:=ComponentPaletteBtnHeight; - Parent := LPSelection; - AllowAllUp := False; - Down := True; - OnClick := OnComponentClick; - end; - - LUpDown := TUpDown.Create(LPage); - LUpDown.Parent := LPage; - LUpDown.Constraints.MaxWidth := 17; - LUpDown.Anchors := [akRight, akTop, akBottom]; - LUpDown.AnchorSideTop.Control := LPage; - LUpDown.AnchorSideRight.Control := LPage; - LUpDown.AnchorSideRight.Side := asrBottom; - LUpDown.AnchorSideBottom.Control := LPage; - LUpDown.AnchorSideBottom.Side := asrBottom; - LUpDown.OnChangingEx := UpDownChangingEx; - - LPComponents := TPanel.Create(LPage); - LPComponents.Parent := LPage; - LPComponents.Width := ComponentPaletteBtnWidth + ComponentPaletteBtnWidth div 2; - LPComponents.Anchors := [akLeft, akTop, akRight, akBottom]; - - LPComponents.AnchorSideLeft.Control := LPSelection; - LPComponents.AnchorSideLeft.Side := asrBottom; - LPComponents.AnchorSideRight.Control := LUpDown; - LPComponents.Top := 0; - LPComponents.AnchorSideBottom.Control := LPage; - LPComponents.AnchorSideBottom.Side := asrBottom; - LPComponents.ChildSizing.Layout := cclLeftToRightThenTopToBottom; - LPComponents.BevelOuter := bvNone; - LUpDown.Visible := False; - FPages.Add(LPage, TPageData.Create(LUpDown, LPComponents, LButton)); - - // not each page has components - for example: searching result - if (APage = nil) or (not APage.Visible) then - Exit; - - for i := 0 to IDEComponentPalette.Comps.Count-1 do - begin - LComponent := IDEComponentPalette.Comps[i]; - - if LComponent.Visible and (LComponent.RealPage = APage) then - with TSpeedButton.Create(LPage) do - begin - LClass := LComponent.ComponentClass; - - LIcon := LoadIcon(LClass.ClassName); - Glyph.Assign(LIcon); - LIcon.Free; - - Hint := Format('%s' + sLineBreak + '(%s)', [LClass.ClassName, LClass.UnitName]); - ShowHint := True; - Flat := True; - GroupIndex := 1; - Constraints.MinWidth:=ComponentPaletteBtnWidth; - Constraints.MinHeight:=ComponentPaletteBtnHeight; - Constraints.MaxWidth:=ComponentPaletteBtnWidth; - Constraints.MaxHeight:=ComponentPaletteBtnHeight; - - Parent := LPComponents; - Tag := PtrInt(LComponent); - OnClick := OnComponentClick; - OnDblClick := OnComponentDblClick; - AllowAllUp := True; - end; - end; - end; - -var - LPage: TBaseComponentPage; - i: Integer; -begin - if FRoot = nil then - Exit; - FPages.Clear; - if Assigned(IDEComponentPalette) then - begin - for i := pcComponents.PageCount - 1 downto 0 do - pcComponents.Pages[i].Free; - CreatePage('Search result', nil); - for i := 0 to IDEComponentPalette.Pages.Count-1 do - begin - LPage := IDEComponentPalette.Pages[i]; - if not LPage.Visible then - Continue; - CreatePage(LPage.PageName, LPage); - end; - end; - pcComponentsResize(nil); - RefreshSearchResult; -end; - -procedure TComponentsPalette.OnDesignSetSelection(const ASelection: TPersistentSelectionList); -begin - // to replace original components palette - if not FIgnoreRoot or (csDestroying in ComponentState) then - Exit; - Root := GlobalDesignHook.LookupRoot; -end; - -end. - diff --git a/components/sparta/smartformeditor/source/sparta_edtu_main.lfm b/components/sparta/smartformeditor/source/sparta_edtu_main.lfm deleted file mode 100644 index e3b326c9f7..0000000000 --- a/components/sparta/smartformeditor/source/sparta_edtu_main.lfm +++ /dev/null @@ -1,106 +0,0 @@ -object edtuMain: TedtuMain - Left = 0 - Height = 22 - Top = 0 - Width = 641 - ClientHeight = 22 - ClientWidth = 641 - TabOrder = 0 - object pEDTU: TPanel - AnchorSideRight.Control = Owner - AnchorSideRight.Side = asrBottom - AnchorSideBottom.Control = Owner - AnchorSideBottom.Side = asrBottom - Left = 534 - Height = 23 - Top = -1 - Width = 107 - Anchors = [akRight, akBottom] - BevelOuter = bvNone - ClientHeight = 23 - ClientWidth = 107 - TabOrder = 0 - object sbShowPalette: TSpeedButton - AnchorSideLeft.Control = pEDTU - AnchorSideRight.Control = pEDTU - AnchorSideRight.Side = asrBottom - AnchorSideBottom.Control = pEDTU - AnchorSideBottom.Side = asrBottom - Left = 84 - Height = 22 - Top = 1 - Width = 23 - Anchors = [akRight, akBottom] - OnClick = sbShowPaletteClick - end - end - object pSearch: TPanel - AnchorSideLeft.Control = pComponents - AnchorSideLeft.Side = asrBottom - AnchorSideTop.Control = Owner - AnchorSideRight.Control = Owner - AnchorSideRight.Side = asrBottom - AnchorSideBottom.Control = pEDTU - Left = 534 - Height = 0 - Top = 0 - Width = 107 - Anchors = [akTop, akLeft, akRight, akBottom] - BevelOuter = bvNone - ChildSizing.ControlsPerLine = 1 - ClientHeight = 0 - ClientWidth = 107 - TabOrder = 1 - object eFilter: TEditButton - AnchorSideLeft.Control = pSearch - AnchorSideTop.Control = pSearch - AnchorSideTop.Side = asrCenter - AnchorSideRight.Control = pSearch - AnchorSideRight.Side = asrBottom - Left = 3 - Height = 23 - Top = -11 - Width = 104 - Anchors = [akTop, akLeft, akRight] - BorderSpacing.Left = 3 - ButtonWidth = 23 - MaxLength = 0 - NumGlyphs = 1 - OnButtonClick = eFilterButtonClick - OnChange = eFilterChange - PasswordChar = #0 - TabOrder = 0 - end - end - object pComponents: TPanel - AnchorSideLeft.Control = Owner - AnchorSideTop.Control = Owner - AnchorSideRight.Control = pEDTU - AnchorSideBottom.Control = Owner - AnchorSideBottom.Side = asrBottom - Left = 0 - Height = 22 - Top = 0 - Width = 534 - Align = alCustom - Anchors = [akTop, akLeft, akRight, akBottom] - BevelOuter = bvNone - TabOrder = 2 - Visible = False - end - object pInfo: TPanel - AnchorSideLeft.Control = Owner - AnchorSideTop.Control = Owner - AnchorSideRight.Control = pEDTU - AnchorSideBottom.Control = Owner - AnchorSideBottom.Side = asrBottom - Left = 0 - Height = 22 - Top = 0 - Width = 534 - Alignment = taLeftJustify - Anchors = [akTop, akLeft, akRight, akBottom] - BevelOuter = bvNone - TabOrder = 3 - end -end diff --git a/components/sparta/smartformeditor/source/sparta_edtu_main.pas b/components/sparta/smartformeditor/source/sparta_edtu_main.pas deleted file mode 100644 index d4ad004786..0000000000 --- a/components/sparta/smartformeditor/source/sparta_edtu_main.pas +++ /dev/null @@ -1,274 +0,0 @@ -{ - ***************************************************************************** - See the file COPYING.modifiedLGPL.txt, included in this distribution, - for details about the license. - ***************************************************************************** - - Author: Maciej Izak - - DaThoX 2004-2015 - FreeSparta.com -} - -unit sparta_EDTU_Main; - -{$mode delphi}{$H+} - -interface - -uses - Classes, SysUtils, FileUtil, Forms, Controls, ExtCtrls, Buttons, ComCtrls, - StdCtrls, Menus, EditBtn, ComponentReg, FormEditingIntf, - LazIDEIntf, SpartaAPI, Math, PropEdits, sparta_ComponentPalette, sparta_FakeForm; - -type - - { TedtuMain } - - TedtuMain = class(TFrame, ISTADesignTimeUtil, ISTAMainDesignTimeUtil) - eFilter: TEditButton; - pInfo: TPanel; - pComponents: TPanel; - pSearch: TPanel; - pEDTU: TPanel; - sbShowPalette: TSpeedButton; - procedure eFilterButtonClick(Sender: TObject); - procedure eFilterChange(Sender: TObject); - procedure sbShowPaletteClick(Sender: TObject); - private - FRoot: TPersistent; - FEDTU: TList; - FNonVisualComponentsEDTU: Pointer; - FComponentsPalette: TComponentsPalette; - - procedure CreateEDTUButtons; - procedure SetRoot(AValue: TPersistent); - function GetRoot: TPersistent; - - function GetShowNonVisualComponents: Boolean; - - procedure OnShowEditorClick(Sender: TObject); - - procedure OnDesignRefreshPropertyValues; - procedure OnPersistentDeleted(APersistent: TPersistent); - procedure OnPersistentAdded(APersistent: TPersistent; Select: boolean); - public - { public declarations } - pAddons: TWinControl; - - constructor Create(AOwner: TComponent); override; - destructor Destroy; override; - property Root: TPersistent read GetRoot write SetRoot; - end; - -implementation - -{$R *.lfm} - -{ TedtuMain } - -procedure TedtuMain.eFilterChange(Sender: TObject); -begin - if Assigned(FComponentsPalette) then - FComponentsPalette.Filter := eFilter.Text; -end; - -procedure TedtuMain.eFilterButtonClick(Sender: TObject); -begin - eFilter.Text := ''; -end; - -procedure TedtuMain.sbShowPaletteClick(Sender: TObject); -begin - if pComponents.Visible = False then - begin - Parent.Height:=55; - Height:=55; - pComponents.Visible := True; - eFilter.SetFocus; - pInfo.Visible := False; - end - else - begin - Parent.Height:=22; - Height:=22; - pComponents.Visible := False; - pInfo.Visible := True; - end; - - if not Assigned(FComponentsPalette) then - begin - FComponentsPalette := TComponentsPalette.Create(pComponents, pComponents); - FComponentsPalette.Root := FRoot; - end; -end; - -procedure TedtuMain.CreateEDTUButtons; -var - i: Integer; - LLeft: TControl; - LButton: TSpeedButton; - LASR: TAnchorSideReference; -begin - FEDTU := TList.Create; - - LLeft := pEDTU; - LASR := asrLeft; - for i := 0 to DTUManager.EDTUCount - 1 do - if DTUManager.EDTU[i].AvailableForRoot(FRoot) then - begin - LButton := TSpeedButton.Create(pEDTU); - with LButton do - begin - Parent := pEDTU; - AnchorSideLeft.Control := LLeft; - AnchorSideLeft.Side := LASR; - AnchorSideBottom.Control := pEDTU; - AnchorSideBottom.Side := asrBottom; - Anchors := [akLeft, akBottom]; - LLeft := LButton; - Tag := -Succ(i); - LoadGlyphFromResourceName(HINSTANCE, DTUManager.EDTU[i].GlyphName); - GroupIndex := 1; - AllowAllUp := True; - OnClick:=OnShowEditorClick; - end; - LASR := asrRight; - end; -end; - -procedure TedtuMain.SetRoot(AValue: TPersistent); -var - i: Integer; -begin - if FRoot = AValue then - Exit; - FRoot := AValue; - - // skoro tu jestesmy pierwszy raz to ARoot <> nil (FRoot domyslnie ma nil) - if FEDTU = nil then - CreateEDTUButtons - else - for i := 0 to FEDTU.Count - 1 do - ISTAExtendedDesignTimeUtil(FEDTU[i]).Root := FRoot; - - if Assigned(FComponentsPalette) then - FComponentsPalette.Root := FRoot; - - OnDesignRefreshPropertyValues; -end; - -function TedtuMain.GetRoot: TPersistent; -begin - Result := FRoot; -end; - -function TedtuMain.GetShowNonVisualComponents: Boolean; -begin - if FNonVisualComponentsEDTU <> nil then - Result := ISTANonVisualComponentsUtil(FNonVisualComponentsEDTU).ShowNonVisualComponents - else - Result := True; -end; - -procedure TedtuMain.OnShowEditorClick(Sender: TObject); -var - LCtrl: TControl; - i: Integer; - LButton: TSpeedButton absolute Sender; - LEDTU: ISTAExtendedDesignTimeUtil; -begin - if FRoot = nil then - Exit; - - if LButton.Tag < 0 then - begin - LEDTU := DTUManager.EDTU[Pred(-LButton.Tag)].CreateEDTUForRoot(pAddons, FRoot); - LEDTU.Parent := pAddons; - LEDTU.RefreshValues; - LButton.Tag := FEDTU.Add(LEDTU); - - if Supports(LEDTU, ISTANonVisualComponentsUtil) then - FNonVisualComponentsEDTU := LEDTU as ISTANonVisualComponentsUtil; - end; - - for i := 0 to pEDTU.ControlCount - 1 do - begin - LCtrl := pEDTU.Controls[i]; - if LButton = LCtrl then - Continue; - - if LCtrl.Tag >= 0 then - ISTAExtendedDesignTimeUtil(FEDTU[LCtrl.Tag]).Visible := False; - end; - - ISTAExtendedDesignTimeUtil(FEDTU[LButton.Tag]).Visible := LButton.Down; - pAddons.Width := ifthen(not LButton.Down, 0, 256); -end; - -procedure TedtuMain.OnDesignRefreshPropertyValues; -var - i: Integer; - f: TFakeForm; - LCtrlCount: Integer = 0; - LCompCount: Integer = 0; - LNonVisualCount: Integer = 0; - - procedure GetCompAndCtrlCount(AComp: TComponent); - var - i: Integer; - LComp: TComponent; - begin - Inc(LCompCount, AComp.ComponentCount); - if AComp is TWinControl then - Inc(LCtrlCount, TWinControl(AComp).ControlCount); - for i := 0 to AComp.ComponentCount - 1 do - GetCompAndCtrlCount(AComp.Components[i]); - end; - -begin - if FRoot <> GlobalDesignHook.LookupRoot then - Exit; - - if FRoot is TForm then - begin - f := TFakeForm(FRoot); - //pInfo.Caption := Format('%s (X: %d Y: %d W: %d H: %d) ComponentCount = %d ControlCount = %d NonVisualCount = %d', - // [f.Name, f.Left, f.Top, f.Width, f.Height, LCompCount, LCtrlCount, LCompCount - LCtrlCount]); - pInfo.Caption := Format('%s (X: %d Y: %d W: %d H: %d)', - [f.Name, f.Left, f.Top, f.Width, f.Height]); - end; -end; - -procedure TedtuMain.OnPersistentDeleted(APersistent: TPersistent); -begin - OnDesignRefreshPropertyValues -end; - -procedure TedtuMain.OnPersistentAdded(APersistent: TPersistent; Select: boolean); -begin - OnDesignRefreshPropertyValues -end; - -constructor TedtuMain.Create(AOwner: TComponent); -begin - inherited Create(AOwner); - - sbShowPalette.LoadGlyphFromResourceName(HINSTANCE, 'SHOW_PALETTE_UP'); - eFilter.Button.LoadGlyphFromResourceName(HINSTANCE, 'MENU_CLOSE'); - GlobalDesignHook.AddHandlerRefreshPropertyValues(OnDesignRefreshPropertyValues); - GlobalDesignHook.AddHandlerPersistentDeleted(OnPersistentDeleted); - GlobalDesignHook.AddHandlerPersistentAdded(OnPersistentAdded); -end; - -destructor TedtuMain.Destroy; -begin - GlobalDesignHook.RemoveHandlerRefreshPropertyValues(OnDesignRefreshPropertyValues); - GlobalDesignHook.RemoveHandlerPersistentDeleted(OnPersistentDeleted); - GlobalDesignHook.RemoveHandlerPersistentAdded(OnPersistentAdded); - FEDTU.Free; - inherited Destroy; -end; - -end. - diff --git a/components/sparta/smartformeditor/source/sparta_fakeformbackground.lfm b/components/sparta/smartformeditor/source/sparta_fakeformbackground.lfm deleted file mode 100644 index 4fdcecf5f1..0000000000 --- a/components/sparta/smartformeditor/source/sparta_fakeformbackground.lfm +++ /dev/null @@ -1,226 +0,0 @@ -object frFakeFormBackground: TfrFakeFormBackground - Left = 0 - Height = 457 - Top = 0 - Width = 591 - Align = alClient - ClientHeight = 457 - ClientWidth = 591 - Color = clYellow - ParentColor = False - TabOrder = 0 - object bBackground: TButton - Left = 0 - Height = 457 - Top = 0 - Width = 591 - Align = alClient - TabOrder = 2 - Visible = False - end - object bTop: TButton - AnchorSideLeft.Control = Owner - AnchorSideTop.Control = Owner - AnchorSideRight.Control = Owner - AnchorSideRight.Side = asrBottom - AnchorSideBottom.Side = asrBottom - Left = 0 - Height = 30 - Top = 0 - Width = 591 - Align = alCustom - Anchors = [akTop, akLeft, akRight] - TabOrder = 1 - end - object bIcon: TImage - AnchorSideLeft.Control = Owner - AnchorSideTop.Control = Owner - Left = 5 - Height = 20 - Top = 5 - Width = 20 - BorderSpacing.Left = 5 - BorderSpacing.Top = 5 - OnClick = bIconClick - end - object bSystem: TImage - AnchorSideTop.Control = Owner - AnchorSideRight.Control = lRight - Left = 564 - Height = 18 - Top = 6 - Width = 18 - Anchors = [akTop, akRight] - BorderSpacing.Top = 6 - BorderSpacing.Right = 3 - OnClick = bOtherClick - end - object bMaximalize: TImage - AnchorSideTop.Control = Owner - AnchorSideRight.Control = bSystem - Left = 543 - Height = 18 - Top = 6 - Width = 18 - Anchors = [akTop, akRight] - BorderSpacing.Top = 6 - BorderSpacing.Right = 3 - OnClick = bOtherClick - end - object bMinimalize: TImage - AnchorSideTop.Control = Owner - AnchorSideRight.Control = bMaximalize - Left = 522 - Height = 18 - Top = 6 - Width = 18 - Anchors = [akTop, akRight] - BorderSpacing.Top = 6 - BorderSpacing.Right = 3 - OnClick = bOtherClick - end - object bHelp: TImage - AnchorSideTop.Control = Owner - AnchorSideRight.Control = bMinimalize - Left = 501 - Height = 18 - Top = 6 - Width = 18 - Anchors = [akTop, akRight] - BorderSpacing.Top = 6 - BorderSpacing.Right = 3 - OnClick = bOtherClick - end - object bResize: TImage - AnchorSideLeft.Control = bIcon - AnchorSideLeft.Side = asrBottom - AnchorSideTop.Control = bIcon - Left = 27 - Height = 20 - Top = 5 - Width = 20 - BorderSpacing.Left = 2 - OnClick = bResizeClick - end - object bOther: TImage - AnchorSideTop.Control = Owner - AnchorSideRight.Control = bHelp - Left = 480 - Height = 18 - Top = 6 - Width = 18 - Anchors = [akTop, akRight] - BorderSpacing.Top = 6 - BorderSpacing.Right = 3 - OnClick = bOtherClick - end - object bFormCaption: TButton - AnchorSideLeft.Control = bResize - AnchorSideLeft.Side = asrBottom - AnchorSideTop.Control = bIcon - AnchorSideRight.Control = bOther - AnchorSideBottom.Control = bIcon - AnchorSideBottom.Side = asrBottom - Left = 49 - Height = 20 - Top = 5 - Width = 429 - Anchors = [akTop, akLeft, akRight, akBottom] - BorderSpacing.Left = 2 - BorderSpacing.Right = 2 - OnClick = bFormCaptionClick - TabOrder = 3 - end - object eFormCaption: TEdit - AnchorSideLeft.Control = bResize - AnchorSideLeft.Side = asrBottom - AnchorSideTop.Control = bIcon - AnchorSideRight.Control = bOther - AnchorSideBottom.Control = bIcon - AnchorSideBottom.Side = asrBottom - Left = 50 - Height = 20 - Top = 5 - Width = 427 - Anchors = [akTop, akLeft, akRight, akBottom] - BorderSpacing.Left = 3 - BorderSpacing.Right = 3 - BorderStyle = bsNone - Color = clSilver - OnEditingDone = eFormCaptionExit - OnExit = eFormCaptionExit - OnKeyDown = eFormCaptionKeyDown - TabOrder = 0 - Text = 'eFormCaption' - Visible = False - end - object lRight: TLabel - AnchorSideTop.Control = Owner - AnchorSideRight.Control = Owner - AnchorSideRight.Side = asrBottom - Left = 585 - Height = 1 - Top = 6 - Width = 1 - Anchors = [akTop, akRight] - BorderSpacing.Top = 6 - BorderSpacing.Right = 5 - ParentColor = False - end - object pmFormStyle: TPopupMenu - left = 64 - top = 96 - object miNone: TMenuItem - Caption = 'bsNone' - OnClick = miNoneClick - end - object miSingle: TMenuItem - Caption = 'bsSingle' - OnClick = miNoneClick - end - object miSizeable: TMenuItem - Caption = 'bsSizeable' - OnClick = miNoneClick - end - object miDialog: TMenuItem - Caption = 'bsDialog' - OnClick = miNoneClick - end - object miToolWindow: TMenuItem - Caption = 'bsToolWindow' - OnClick = miNoneClick - end - object miSizeToolWin: TMenuItem - Caption = 'bsSizeToolWin' - OnClick = miNoneClick - end - end - object pmBorderIcons: TPopupMenu - OnPopup = pmBorderIconsPopup - left = 168 - top = 96 - object miRemove: TMenuItem - Caption = 'Remove' - OnClick = miRemoveClick - end - object miLine: TMenuItem - Caption = '-' - end - object miAddHelp: TMenuItem - Caption = 'Add Help' - OnClick = miAddHelpClick - end - object miAddMinimize: TMenuItem - Caption = 'Add Minimize' - OnClick = miAddHelpClick - end - object miAddMaximize: TMenuItem - Caption = 'Add Maximize' - OnClick = miAddHelpClick - end - object miAddSystemMenu: TMenuItem - Caption = 'Add System Menu' - OnClick = miAddHelpClick - end - end -end diff --git a/components/sparta/smartformeditor/source/sparta_fakeformbackground.pas b/components/sparta/smartformeditor/source/sparta_fakeformbackground.pas deleted file mode 100644 index 8b3da570bb..0000000000 --- a/components/sparta/smartformeditor/source/sparta_fakeformbackground.pas +++ /dev/null @@ -1,435 +0,0 @@ -{ - ***************************************************************************** - See the file COPYING.modifiedLGPL.txt, included in this distribution, - for details about the license. - ***************************************************************************** - - Author: Maciej Izak - - DaThoX 2004-2015 - FreeSparta.com -} - -unit sparta_FakeFormBackground; - -{$mode objfpc}{$H+} - -interface - -uses - Classes, SysUtils, FileUtil, - // BGRAButton, - // BGRAImageButton, - Forms, Controls, StdCtrls, ExtCtrls, Menus, sparta_DesignedForm, - LCLType, LMessages, PropEdits, Graphics, sparta_InterfacesMDI; - -type - - { TfrFakeFormBackground } - - TfrFakeFormBackground = class(TFrame, IDesignedFormBackground) - bBackground: TButton; - bTop: TButton; - bFormCaption: TButton; - bOther: TImage; - bResize: TImage; - bIcon: TImage; - bSystem: TImage; - bMaximalize: TImage; - bMinimalize: TImage; - bHelp: TImage; - eFormCaption: TEdit; - lRight: TLabel; - miNone: TMenuItem; - miSingle: TMenuItem; - miSizeable: TMenuItem; - miDialog: TMenuItem; - miToolWindow: TMenuItem; - miSizeToolWin: TMenuItem; - miAddMinimize: TMenuItem; - miAddSystemMenu: TMenuItem; - miAddMaximize: TMenuItem; - miAddHelp: TMenuItem; - miLine: TMenuItem; - miRemove: TMenuItem; - pmFormStyle: TPopupMenu; - pmBorderIcons: TPopupMenu; - procedure bFormCaptionClick(Sender: TObject); - procedure bIconClick(Sender: TObject); - procedure bOtherClick(Sender: TObject); - procedure bResizeClick(Sender: TObject); - procedure eFormCaptionExit(Sender: TObject); - procedure eFormCaptionKeyDown(Sender: TObject; var Key: Word; - Shift: TShiftState); - procedure miAddHelpClick(Sender: TObject); - procedure miNoneClick(Sender: TObject); - procedure miRemoveClick(Sender: TObject); - procedure pmBorderIconsPopup(Sender: TObject); - private - FDesignedForm: IDesignedForm; - FDesignedFakeForm: IDesignedFakeForm; - - function RootIsSelected: Boolean; - - function GetMargin(const AIndex: Integer): Integer; - procedure OnUserInputHandler(Sender: TObject; Msg: Cardinal); - procedure OnDesignRefreshPropertyValues; - protected - function GetParent: TWinControl; virtual; - procedure SetParent(AParent: TWinControl); override; - - function GetDesignedForm: IDesignedForm; - function GetResizeFrame: IResizeFrame; - procedure SetResizeFrame(AValue: IResizeFrame); - public - { public declarations } - constructor Create(const ADesignedForm: IDesignedForm; const ADesignedFakeForm: IDesignedFakeForm); virtual; reintroduce; - destructor Destroy; override; - - procedure RefreshValues; - - procedure UpdateBorderIcons; - procedure UpdateCaption; - end; - -implementation - -{$R *.lfm} -{$R *.res} - -uses - sparta_MainIDE; - -var - Frames: TList; - -{ TfrFakeFormBackground } - -procedure TfrFakeFormBackground.miAddHelpClick(Sender: TObject); -begin - if Sender = miAddHelp then - FDesignedFakeForm.BorderIcons:=FDesignedFakeForm.BorderIcons + [biHelp] - else if Sender = miAddMaximize then - FDesignedFakeForm.BorderIcons:=FDesignedFakeForm.BorderIcons + [biMaximize] - else if Sender = miAddMinimize then - FDesignedFakeForm.BorderIcons:=FDesignedFakeForm.BorderIcons + [biMinimize] - else if Sender = miAddSystemMenu then - FDesignedFakeForm.BorderIcons:=FDesignedFakeForm.BorderIcons + [biSystemMenu]; - - GlobalDesignHook.Modified(Self); - if not RootIsSelected then - RefreshValues - else - GlobalDesignHook.RefreshPropertyValues; -end; - -procedure TfrFakeFormBackground.miNoneClick(Sender: TObject); -begin - if Sender = miNone then - FDesignedFakeForm.BorderStyle := bsNone - else if Sender = miSingle then - FDesignedFakeForm.BorderStyle := bsSingle - else if Sender = miSizeable then - FDesignedFakeForm.BorderStyle := bsSizeable - else if Sender = miDialog then - FDesignedFakeForm.BorderStyle := bsDialog - else if Sender = miToolWindow then - FDesignedFakeForm.BorderStyle := bsToolWindow - else if Sender = miSizeToolWin then - FDesignedFakeForm.BorderStyle := bsSizeToolWin - ; - - GlobalDesignHook.Modified(Self); - if not RootIsSelected then - RefreshValues - else - GlobalDesignHook.RefreshPropertyValues; -end; - -procedure TfrFakeFormBackground.miRemoveClick(Sender: TObject); -begin - if pmBorderIcons.Tag = PtrInt(bHelp) then - FDesignedFakeForm.BorderIcons:=FDesignedFakeForm.BorderIcons - [biHelp] - else if pmBorderIcons.Tag = PtrInt(bMaximalize) then - FDesignedFakeForm.BorderIcons:=FDesignedFakeForm.BorderIcons - [biMaximize] - else if pmBorderIcons.Tag = PtrInt(bMinimalize) then - FDesignedFakeForm.BorderIcons:=FDesignedFakeForm.BorderIcons - [biMinimize] - else if pmBorderIcons.Tag = PtrInt(bSystem) then - FDesignedFakeForm.BorderIcons:=FDesignedFakeForm.BorderIcons - [biSystemMenu]; - - GlobalDesignHook.Modified(Self); - if not RootIsSelected then - RefreshValues - else - GlobalDesignHook.RefreshPropertyValues; -end; - -procedure TfrFakeFormBackground.pmBorderIconsPopup(Sender: TObject); -begin - miRemove.Visible := pmBorderIcons.Tag <> PtrInt(bOther); - miLine.Visible := (pmBorderIcons.Tag <> PtrInt(bOther)) and (not bHelp.Visible or not bMinimalize.Visible or - not bMaximalize.Visible or not bSystem.Visible); - miAddHelp.Visible := not bHelp.Visible; - miAddMinimize.Visible := not bMinimalize.Visible; - miAddMaximize.Visible := not bMaximalize.Visible; - miAddSystemMenu.Visible := not bSystem.Visible; -end; - -function TfrFakeFormBackground.RootIsSelected: Boolean; -var - LSelection: TPersistentSelectionList; - i: integer; -begin - Result := False; - LSelection := TPersistentSelectionList.Create; - GlobalDesignHook.GetSelection(LSelection); - for i := 0 to LSelection.Count - 1 do - if LSelection.Items[i] = FDesignedForm.Form then - begin - Result := True; - Break; - end; - LSelection.Free; -end; - -procedure TfrFakeFormBackground.bIconClick(Sender: TObject); -begin - pmFormStyle.PopUp(Mouse.CursorPos.x, Mouse.CursorPos.y); -end; - -procedure TfrFakeFormBackground.bFormCaptionClick(Sender: TObject); -begin - eFormCaption.Visible := True; - eFormCaption.SetFocus; -end; - -procedure TfrFakeFormBackground.bOtherClick(Sender: TObject); -begin - pmBorderIcons.Tag := PtrInt(Sender); - pmBorderIcons.PopUp(Mouse.CursorPos.x, Mouse.CursorPos.y); -end; - -procedure TfrFakeFormBackground.bResizeClick(Sender: TObject); -begin - case FDesignedFakeForm.BorderStyle of - bsSizeable: miNoneClick(miSingle); - bsSingle: miNoneClick(miSizeable); - bsToolWindow: miNoneClick(miSizeToolWin); - bsSizeToolWin: miNoneClick(miToolWindow); - end; -end; - -procedure TfrFakeFormBackground.eFormCaptionExit(Sender: TObject); -begin - bFormCaption.Caption := eFormCaption.Text; - eFormCaption.Visible := False; - FDesignedFakeForm.Caption := eFormCaption.Text; - GlobalDesignHook.Modified(Self); - GlobalDesignHook.RefreshPropertyValues; -end; - -procedure TfrFakeFormBackground.eFormCaptionKeyDown(Sender: TObject; - var Key: Word; Shift: TShiftState); -begin - if Key = VK_RETURN then - eFormCaptionExit(eFormCaption); -end; - -function TfrFakeFormBackground.GetMargin(const AIndex: Integer): Integer; -begin - case AIndex of - 0: // left - Result := 5; - 1: // Top - Result := 30; - 2: // Right - Result := 5; - 3: // Bottom - Result := 5; - end; -end; - -procedure TfrFakeFormBackground.OnUserInputHandler(Sender: TObject; Msg: Cardinal); -var - LCtrl: TControl; - LIDE: IDesignedFormIDE; -begin - LIDE := FDesignedForm as IDesignedFormIDE; - if LIDE.LastActiveSourceWindow = nil then - Exit; - - if FindModulePageControl(LIDE.LastActiveSourceWindow).PageIndex <> 1 then - Exit; - - LCtrl := FindDragTarget(Mouse.CursorPos, True); - if eFormCaption.Visible and (LCtrl <> eFormCaption) then - eFormCaptionExit(eFormCaption); -end; - -procedure TfrFakeFormBackground.OnDesignRefreshPropertyValues; -begin - if RootIsSelected then - RefreshValues; -end; - -function TfrFakeFormBackground.GetParent: TWinControl; -begin - Result := inherited Parent; -end; - -procedure TfrFakeFormBackground.SetParent(AParent: TWinControl); -begin - inherited SetParent(AParent); - UpdateBorderIcons; - UpdateCaption; -end; - -function TfrFakeFormBackground.GetDesignedForm: IDesignedForm; -begin - Result := FDesignedForm as IDesignedForm; -end; - -function TfrFakeFormBackground.GetResizeFrame: IResizeFrame; -begin - Result := nil; -end; - -procedure TfrFakeFormBackground.SetResizeFrame(AValue: IResizeFrame); -begin -end; - -constructor TfrFakeFormBackground.Create(const ADesignedForm: IDesignedForm; - const ADesignedFakeForm: IDesignedFakeForm); -begin - inherited Create(nil); - FDesignedForm := ADesignedForm; - FDesignedFakeForm := ADesignedFakeForm; - Frames.Add(Self); - - GlobalDesignHook.AddHandlerRefreshPropertyValues(@OnDesignRefreshPropertyValues); - RefreshValues; -end; - -destructor TfrFakeFormBackground.Destroy; -begin - Pointer(FDesignedForm) := nil; - Pointer(FDesignedFakeForm) := nil; - Frames.Remove(Self); - GlobalDesignHook.RemoveHandlerRefreshPropertyValues(@OnDesignRefreshPropertyValues); - inherited Destroy; -end; - -procedure TfrFakeFormBackground.RefreshValues; - - procedure SetBorderStyle({ABorderStyle: TBGRABorderStyle}); - begin - {bBackground.BorderStyle.BottomLeft:=ABorderStyle; - bBackground.BorderStyle.BottomRight:=ABorderStyle; - bBackground.BorderStyle.TopLeft:=ABorderStyle; - bBackground.BorderStyle.TopRight:=ABorderStyle; } - end; - - procedure LoadPng(ABitmap: TCustomBitmap; AName: string); - var - LPng: TPortableNetworkGraphic; - begin - LPng := TPortableNetworkGraphic.Create; - LPng.LoadFromResourceName(HINSTANCE, AName); - ABitmap.Assign(LPng); - LPng.Free; - end; - - procedure SelectFormStyle(AMenuItem: TMenuItem); - begin - miNone.Checked:=False; - miSingle.Checked:=False; - miSizeable.Checked:=False; - miDialog.Checked:=False; - miToolWindow.Checked:=False; - miSizeToolWin.Checked:=False; - AMenuItem.Checked:=True; - end; - -begin - UpdateBorderIcons; - UpdateCaption; - - if FDesignedFakeForm.BorderStyle in [bsSizeable, bsSizeToolWin] then - LoadPng(bResize.Picture.Bitmap, 'form_bg_resize') - else - LoadPng(bResize.Picture.Bitmap, 'form_bg_noresize'); - - case FDesignedFakeForm.BorderStyle of - bsToolWindow, bsSizeToolWin: SetBorderStyle({bsSquare}); - bsSingle, bsSizeable, bsNone: SetBorderStyle({bsRound}); - bsDialog: SetBorderStyle({bsBevel}); - end; - - case FDesignedFakeForm.BorderStyle of - bsToolWindow: SelectFormStyle(miToolWindow); - bsSizeToolWin: SelectFormStyle(miSizeToolWin); - bsSingle: SelectFormStyle(miSingle); - bsSizeable:SelectFormStyle(miSizeable); - bsNone: SelectFormStyle(miNone); - bsDialog: SelectFormStyle(miDialog); - end; - - bTop.Visible := FDesignedFakeForm.BorderStyle = bsNone; - bBackground.Visible := FDesignedFakeForm.BorderStyle <> bsNone; -end; - -procedure TfrFakeFormBackground.UpdateBorderIcons; -begin - if FDesignedFakeForm = nil then - Exit; - - bOther.Visible := (FDesignedFakeForm.BorderIcons * [biSystemMenu, biMinimize, biMaximize, biHelp]) = []; - bHelp.Visible := biHelp in FDesignedFakeForm.BorderIcons; - bMinimalize.Visible := biMinimize in FDesignedFakeForm.BorderIcons; - bMaximalize.Visible := biMaximize in FDesignedFakeForm.BorderIcons; - bSystem.Visible := biSystemMenu in FDesignedFakeForm.BorderIcons; -end; - -procedure TfrFakeFormBackground.UpdateCaption; -begin - if FDesignedFakeForm = nil then - Exit; - - bFormCaption.Caption := FDesignedFakeForm.Caption; - eFormCaption.Caption := FDesignedFakeForm.Caption; -end; - -type - - { OnUserInputHandler } - - TOnUserInputHandler = class - public - class procedure OnUserInputHandler(Sender: TObject; Msg: Cardinal); - end; - -{ OnUserInputHandler } - -class procedure TOnUserInputHandler.OnUserInputHandler(Sender: TObject; Msg: Cardinal); -var - p: pointer; - frame: TfrFakeFormBackground absolute p; -begin - case Msg of - LM_LBUTTONDOWN, LM_RBUTTONDOWN, LM_MBUTTONDOWN, LM_XBUTTONDOWN: - for p in Frames do - if frame.Parent <> nil then // jesli robilismy popupparent framesy sie tworzyly i byl przypisywany zly caption - frame.OnUserInputHandler(Sender, Msg); - end; -end; - -var - OnUserInputHandler: TOnUserInputHandler; -initialization - Frames := TList.Create; - Application.AddOnUserInputHandler(@OnUserInputHandler.OnUserInputHandler); -finalization - Application.RemoveOnUserInputHandler(@OnUserInputHandler.OnUserInputHandler); - Frames.Free; -end. - diff --git a/components/sparta/smartformeditor/source/sparta_fakeformbackground.res b/components/sparta/smartformeditor/source/sparta_fakeformbackground.res deleted file mode 100644 index 6f0786b80d..0000000000 Binary files a/components/sparta/smartformeditor/source/sparta_fakeformbackground.res and /dev/null differ diff --git a/components/sparta/smartformeditor/source/sparta_fakeformbg.pas b/components/sparta/smartformeditor/source/sparta_fakeformbg.pas deleted file mode 100644 index 66c07d1873..0000000000 --- a/components/sparta/smartformeditor/source/sparta_fakeformbg.pas +++ /dev/null @@ -1,60 +0,0 @@ -{ - ***************************************************************************** - See the file COPYING.modifiedLGPL.txt, included in this distribution, - for details about the license. - ***************************************************************************** - - Author: Maciej Izak - - DaThoX 2004-2015 - FreeSparta.com -} - -unit sparta_FakeFormBG; - -{$mode delphi}{$H+} - -interface - -uses - Classes, SysUtils, sparta_FakeForm, sparta_FakeFormBackground, sparta_DesignedForm, - sparta_InterfacesMDI; - -type - - { TFakeFormBG } - - TFakeFormBG = class(TFakeForm, IDesignedFormBackground) - private - FBackground: IDesignedFormBackground; - public - property Background: IDesignedFormBackground read FBackground implements IDesignedFormBackground; - constructor CreateNew(AOwner: TComponent; Num: Integer = 0); override; - destructor Destroy; override; - end; - -implementation - -{ TFakeFormBG } - -constructor TFakeFormBG.CreateNew(AOwner: TComponent; Num: Integer); -begin - FBackground := TfrFakeFormBackground.Create(DesignedForm, Self); - FBackground._AddRef; - - inherited CreateNew(AOwner, Num); -end; - -destructor TFakeFormBG.Destroy; -var - I: IInterfaceComponentReference; -begin - inherited; - FBackground.QueryInterface(IInterfaceComponentReference, I); // only way to omit SIGSEGV - I.GetComponent.Free; - Pointer(I) := nil; // omit _Release (Free is above) - Pointer(FBackground) := nil; // omit _Release (Free is above) -end; - -end. - diff --git a/components/sparta/smartformeditor/source/sparta_reg_smartformeditor.pas b/components/sparta/smartformeditor/source/sparta_reg_smartformeditor.pas deleted file mode 100644 index 60a4a39785..0000000000 --- a/components/sparta/smartformeditor/source/sparta_reg_smartformeditor.pas +++ /dev/null @@ -1,69 +0,0 @@ -{ - ***************************************************************************** - See the file COPYING.modifiedLGPL.txt, included in this distribution, - for details about the license. - ***************************************************************************** - - Author: Maciej Izak - - DaThoX 2004-2015 - FreeSparta.com -} - -unit sparta_reg_SmartFormEditor; - -{$WARNING Package Sparta_SmartFormEditor is deprecated} -{$WARNING It will be removed from Lazarus sources in next major release} -{$mode objfpc}{$H+} - -interface - -uses - Classes, SysUtils, SpartaAPI, sparta_EDTU_Main, Controls, FormEditingIntf, sparta_FakeFormBG; - -type - - { TStarterDesignTimeUtilsManager } - - TStarterDesignTimeUtilsManager = class(TSTADesignTimeUtilsManager) - public - function CreateMainDTU(AParent, AAddons: TWinControl): ISTAMainDesignTimeUtil; override; - end; - -procedure Register; - -implementation - -var - Manager: TStarterDesignTimeUtilsManager = nil; - -procedure Register; -begin - //FormEditingHook.StandardDesignerBaseClasses[DesignerBaseClassId_TForm] := TFakeFormBG; - Manager := TStarterDesignTimeUtilsManager.Create; - DTUManager := Manager; -end; - -{ TStarterDesignTimeUtilsManager } - -function TStarterDesignTimeUtilsManager.CreateMainDTU(AParent, - AAddons: TWinControl): ISTAMainDesignTimeUtil; -var - LMain: TedtuMain; -begin - LMain := TedtuMain.Create(AParent); - with LMain do - begin - Parent := AParent; - Align := alTop; - AParent.Height := 22; - Height := 22; - pAddons := AAddons; - end; - Result := LMain; -end; - -finalization - Manager.Free; -end. - diff --git a/components/sparta/smartformeditor/sparta_smartformeditor.lpk b/components/sparta/smartformeditor/sparta_smartformeditor.lpk deleted file mode 100644 index fa30f8937f..0000000000 --- a/components/sparta/smartformeditor/sparta_smartformeditor.lpk +++ /dev/null @@ -1,53 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/components/sparta/smartformeditor/sparta_smartformeditor.pas b/components/sparta/smartformeditor/sparta_smartformeditor.pas deleted file mode 100644 index d17293c413..0000000000 --- a/components/sparta/smartformeditor/sparta_smartformeditor.pas +++ /dev/null @@ -1,23 +0,0 @@ -{ This file was automatically created by Lazarus. Do not edit! - This source is only used to compile and install the package. - } - -unit sparta_SmartFormEditor; - -interface - -uses - sparta_reg_SmartFormEditor, sparta_FakeFormBackground, sparta_FakeFormBG, - sparta_EDTU_Main, sparta_ComponentPalette, LazarusPackageIntf; - -implementation - -procedure Register; -begin - RegisterUnit('sparta_reg_SmartFormEditor', - @sparta_reg_SmartFormEditor.Register); -end; - -initialization - RegisterPackage('sparta_SmartFormEditor', @Register); -end. diff --git a/components/sparta/toolsapi/source/designeditors.pas b/components/sparta/toolsapi/source/designeditors.pas deleted file mode 100644 index 5ff2403708..0000000000 --- a/components/sparta/toolsapi/source/designeditors.pas +++ /dev/null @@ -1,592 +0,0 @@ -unit DesignEditors; - -{$mode delphi}{$H+} - -interface - -uses - Classes, SysUtils, TypInfo, IniFiles, - Menus, - ComponentEditors, PropEdits, - Generics.Defaults, - DesignIntf, DesignMenus; - -type - - { TComponentEditor } - - TComponentEditor = class(TBaseComponentEditor, IComponentEditor) - private - //FLazaComponentEditors: ComponentEditors.TComponentEditor; - FComponent: TComponent; - FDesigner: IDesigner; - public - constructor Create(AComponent: TComponent; ADesigner: IDesigner); override; - procedure Edit; virtual; - procedure ExecuteVerb(Index: Integer); virtual; - function GetComponent: TComponent; - function GetDesigner: IDesigner; - function GetVerb(Index: Integer): string; virtual; - function GetVerbCount: Integer; virtual; - function IsInInlined: Boolean; - procedure Copy; virtual; - procedure PrepareItem(Index: Integer; const AItem: IMenuItem); virtual; - property Component: TComponent read FComponent; - property Designer: IDesigner read GetDesigner; - end; - -implementation - -type - - { TIDesignerProxy } - - TIDesignerProxy = class(TInterfacedObject, IDesigner60, IDesigner70, IDesigner80, - IDesigner100, IDesigner) - private - FLazarusDesigner: TComponentEditorDesigner; - public - constructor Create(ADesigner: TComponentEditorDesigner); - - // IDesigner60 - procedure Activate; - procedure Modified; - function CreateMethod(const Name: string; TypeData: PTypeData): TMethod; overload; - function GetMethodName(const Method: TMethod): string; - procedure GetMethods(TypeData: PTypeData; Proc: TGetStrProc); overload; - function GetPathAndBaseExeName: string; - function GetPrivateDirectory: string; - function GetBaseRegKey: string; - function GetIDEOptions: TCustomIniFile; - procedure GetSelections(const List: IDesignerSelections); - function MethodExists(const Name: string): Boolean; - procedure RenameMethod(const CurName, NewName: string); - procedure SelectComponent(Instance: TPersistent); overload; - procedure SetSelections(const List: IDesignerSelections); - procedure ShowMethod(const Name: string); - procedure GetComponentNames(TypeData: PTypeData; Proc: TGetStrProc); - function GetComponent(const Name: string): TComponent; - function GetComponentName(Component: TComponent): string; - function GetObject(const Name: string): TPersistent; - function GetObjectName(Instance: TPersistent): string; - procedure GetObjectNames(TypeData: PTypeData; Proc: TGetStrProc); - function MethodFromAncestor(const Method: TMethod): Boolean; - function CreateComponent(ComponentClass: TComponentClass; Parent: TComponent; - Left, Top, Width, Height: Integer): TComponent; - function CreateCurrentComponent(Parent: TComponent; const Rect: TRect): TComponent; - function IsComponentLinkable(Component: TComponent): Boolean; - function IsComponentHidden(Component: TComponent): Boolean; - procedure MakeComponentLinkable(Component: TComponent); - procedure Revert(Instance: TPersistent; PropInfo: PPropInfo); - function GetIsDormant: Boolean; - procedure GetProjectModules(Proc: TGetModuleProc); - function GetAncestorDesigner: IDesigner; - function IsSourceReadOnly: Boolean; - function GetScrollRanges(const ScrollPosition: TPoint): TPoint; - procedure Edit(const Component: TComponent); - procedure ChainCall(const MethodName, InstanceName, InstanceMethod: string; - TypeData: PTypeData); overload; - procedure ChainCall(const MethodName, InstanceName, InstanceMethod: string; - const AEventInfo: IEventInfo); overload; - procedure CopySelection; - procedure CutSelection; - function CanPaste: Boolean; - procedure PasteSelection; - procedure DeleteSelection(ADoAll: Boolean = False); - procedure ClearSelection; - procedure NoSelection; - procedure ModuleFileNames(var ImplFileName, IntfFileName, FormFileName: string); - function GetRootClassName: string; - function UniqueName(const BaseName: string): string; - function GetRoot: TComponent; - function GetShiftState: TShiftState; - procedure ModalEdit(EditKey: Char; const ReturnWindow: IActivatable); - procedure SelectItemName(const PropertyName: string); - procedure Resurrect; - - // IDesigner70 - function GetActiveClassGroup: TPersistentClass; - function FindRootAncestor(const AClassName: string): TComponent; - - // IDesigner80 - function CreateMethod(const Name: string; const AEventInfo: IEventInfo): TMethod; overload; - procedure GetMethods(const AEventInfo: IEventInfo; Proc: TGetStrProc); overload; - procedure SelectComponent(const ADesignObject: IDesignObject); overload; - - // IDesigner100 = interface(IDesigner80) - function GetDesignerExtension: string; - - // IDesigner - function GetAppDataDirectory(Local: Boolean = False): string; - end; - - - { TComponentEditorProxy } - - TComponentEditorProxy = class(ComponentEditors.TComponentEditor) - private - FDelphiComponentEditor: TComponentEditor; - public - constructor Create(AComponent: TComponent; - ADesigner: TComponentEditorDesigner); override; - procedure Edit; override; - procedure ExecuteVerb(Index: Integer); override; - function GetComponent: TComponent; override; - function GetCustomHint: String; override; - function GetDesigner: TComponentEditorDesigner; override; - function GetVerb(Index: Integer): string; override; - function GetVerbCount: Integer; override; - function IsInInlined: Boolean; override; - procedure Copy; override; - procedure PrepareItem({%H-}Index: Integer; const {%H-}AnItem: TMenuItem); override; - function GetHook(out Hook: TPropertyEditorHook): boolean; override; - procedure Modified; override; - end; - -{ TIDesignerProxy } - -constructor TIDesignerProxy.Create(ADesigner: TComponentEditorDesigner); -begin - inherited Create; - FLazarusDesigner := ADesigner; -end; - -procedure TIDesignerProxy.Activate; -begin - -end; - -procedure TIDesignerProxy.Modified; -begin - FLazarusDesigner.Modified; -end; - -function TIDesignerProxy.CreateMethod(const Name: string; TypeData: PTypeData - ): TMethod; -begin - FLazarusDesigner.PropertyEditorHook.CreateMethod(Name, TypeData.BaseType, - FLazarusDesigner.LookupRoot, ''); -end; - -function TIDesignerProxy.GetMethodName(const Method: TMethod): string; -begin - -end; - -procedure TIDesignerProxy.GetMethods(TypeData: PTypeData; Proc: TGetStrProc); -begin - -end; - -function TIDesignerProxy.GetPathAndBaseExeName: string; -begin - -end; - -function TIDesignerProxy.GetPrivateDirectory: string; -begin - -end; - -function TIDesignerProxy.GetBaseRegKey: string; -begin - -end; - -function TIDesignerProxy.GetIDEOptions: TCustomIniFile; -begin - -end; - -procedure TIDesignerProxy.GetSelections(const List: IDesignerSelections); -begin - -end; - -function TIDesignerProxy.MethodExists(const Name: string): Boolean; -begin - -end; - -procedure TIDesignerProxy.RenameMethod(const CurName, NewName: string); -begin - -end; - -procedure TIDesignerProxy.SelectComponent(Instance: TPersistent); -begin - -end; - -procedure TIDesignerProxy.SetSelections(const List: IDesignerSelections); -begin - -end; - -procedure TIDesignerProxy.ShowMethod(const Name: string); -begin - -end; - -procedure TIDesignerProxy.GetComponentNames(TypeData: PTypeData; - Proc: TGetStrProc); -begin - -end; - -function TIDesignerProxy.GetComponent(const Name: string): TComponent; -begin - -end; - -function TIDesignerProxy.GetComponentName(Component: TComponent): string; -begin - -end; - -function TIDesignerProxy.GetObject(const Name: string): TPersistent; -begin - -end; - -function TIDesignerProxy.GetObjectName(Instance: TPersistent): string; -begin - -end; - -procedure TIDesignerProxy.GetObjectNames(TypeData: PTypeData; Proc: TGetStrProc - ); -begin - -end; - -function TIDesignerProxy.MethodFromAncestor(const Method: TMethod): Boolean; -begin - -end; - -function TIDesignerProxy.CreateComponent(ComponentClass: TComponentClass; - Parent: TComponent; Left, Top, Width, Height: Integer): TComponent; -begin - -end; - -function TIDesignerProxy.CreateCurrentComponent(Parent: TComponent; - const Rect: TRect): TComponent; -begin - -end; - -function TIDesignerProxy.IsComponentLinkable(Component: TComponent): Boolean; -begin - -end; - -function TIDesignerProxy.IsComponentHidden(Component: TComponent): Boolean; -begin - -end; - -procedure TIDesignerProxy.MakeComponentLinkable(Component: TComponent); -begin - -end; - -procedure TIDesignerProxy.Revert(Instance: TPersistent; PropInfo: PPropInfo); -begin - -end; - -function TIDesignerProxy.GetIsDormant: Boolean; -begin - -end; - -procedure TIDesignerProxy.GetProjectModules(Proc: TGetModuleProc); -begin - -end; - -function TIDesignerProxy.GetAncestorDesigner: IDesigner; -begin - -end; - -function TIDesignerProxy.IsSourceReadOnly: Boolean; -begin - -end; - -function TIDesignerProxy.GetScrollRanges(const ScrollPosition: TPoint): TPoint; -begin - -end; - -procedure TIDesignerProxy.Edit(const Component: TComponent); -begin - -end; - -procedure TIDesignerProxy.ChainCall(const MethodName, InstanceName, - InstanceMethod: string; TypeData: PTypeData); -begin - -end; - -procedure TIDesignerProxy.ChainCall(const MethodName, InstanceName, - InstanceMethod: string; const AEventInfo: IEventInfo); -begin - -end; - -procedure TIDesignerProxy.CopySelection; -begin - -end; - -procedure TIDesignerProxy.CutSelection; -begin - -end; - -function TIDesignerProxy.CanPaste: Boolean; -begin - -end; - -procedure TIDesignerProxy.PasteSelection; -begin - -end; - -procedure TIDesignerProxy.DeleteSelection(ADoAll: Boolean); -begin - -end; - -procedure TIDesignerProxy.ClearSelection; -begin - -end; - -procedure TIDesignerProxy.NoSelection; -begin - -end; - -procedure TIDesignerProxy.ModuleFileNames(var ImplFileName, IntfFileName, - FormFileName: string); -begin - -end; - -function TIDesignerProxy.GetRootClassName: string; -begin - -end; - -function TIDesignerProxy.UniqueName(const BaseName: string): string; -begin - -end; - -function TIDesignerProxy.GetRoot: TComponent; -begin - -end; - -function TIDesignerProxy.GetShiftState: TShiftState; -begin - -end; - -procedure TIDesignerProxy.ModalEdit(EditKey: Char; - const ReturnWindow: IActivatable); -begin - -end; - -procedure TIDesignerProxy.SelectItemName(const PropertyName: string); -begin - -end; - -procedure TIDesignerProxy.Resurrect; -begin - -end; - -function TIDesignerProxy.GetActiveClassGroup: TPersistentClass; -begin - -end; - -function TIDesignerProxy.FindRootAncestor(const AClassName: string): TComponent; -begin - -end; - -function TIDesignerProxy.CreateMethod(const Name: string; - const AEventInfo: IEventInfo): TMethod; -begin - -end; - -procedure TIDesignerProxy.GetMethods(const AEventInfo: IEventInfo; - Proc: TGetStrProc); -begin - -end; - -procedure TIDesignerProxy.SelectComponent(const ADesignObject: IDesignObject); -begin - -end; - -function TIDesignerProxy.GetDesignerExtension: string; -begin - -end; - -function TIDesignerProxy.GetAppDataDirectory(Local: Boolean): string; -begin - -end; - -constructor TComponentEditorProxy.Create(AComponent: TComponent; - ADesigner: TComponentEditorDesigner); -begin - inherited Create(AComponent, ADesigner); - //TComponentEditor.Create(); -end; - -procedure TComponentEditorProxy.Edit; -begin - inherited Edit; -end; - -procedure TComponentEditorProxy.ExecuteVerb(Index: Integer); -begin - inherited ExecuteVerb(Index); -end; - -function TComponentEditorProxy.GetComponent: TComponent; -begin - Result:=inherited GetComponent; -end; - -function TComponentEditorProxy.GetCustomHint: String; -begin - Result:=inherited GetCustomHint; -end; - -function TComponentEditorProxy.GetDesigner: TComponentEditorDesigner; -begin - Result:=inherited GetDesigner; -end; - -function TComponentEditorProxy.GetVerb(Index: Integer): string; -begin - Result:=inherited GetVerb(Index); -end; - -function TComponentEditorProxy.GetVerbCount: Integer; -begin - Result:=inherited GetVerbCount; -end; - -function TComponentEditorProxy.IsInInlined: Boolean; -begin - Result:=inherited IsInInlined; -end; - -procedure TComponentEditorProxy.Copy; -begin - inherited Copy; -end; - -procedure TComponentEditorProxy.PrepareItem(Index: Integer; - const AnItem: TMenuItem); -begin - inherited PrepareItem(Index, AnItem); -end; - -function TComponentEditorProxy.GetHook(out Hook: TPropertyEditorHook): boolean; -begin - Result:=inherited GetHook(Hook); -end; - -procedure TComponentEditorProxy.Modified; -begin - inherited Modified; -end; - -{ TComponentEditor } - -constructor TComponentEditor.Create(AComponent: TComponent; ADesigner: IDesigner - ); -begin - inherited Create(AComponent, ADesigner); - - //FLazComponentEditors := ComponentEditors.TComponentEditor.Create(AComponent); - FComponent := AComponent; - FDesigner := ADesigner; -end; - -procedure TComponentEditor.Edit; -begin - -end; - -procedure TComponentEditor.ExecuteVerb(Index: Integer); -begin - -end; - -function TComponentEditor.GetComponent: TComponent; -begin - -end; - -function TComponentEditor.GetDesigner: IDesigner; -begin - -end; - -function TComponentEditor.GetVerb(Index: Integer): string; -begin - -end; - -function TComponentEditor.GetVerbCount: Integer; -begin - -end; - -function TComponentEditor.IsInInlined: Boolean; -begin - -end; - -procedure TComponentEditor.Copy; -begin - -end; - -procedure TComponentEditor.PrepareItem(Index: Integer; const AItem: IMenuItem); -begin - -end; - -procedure LazRegisterComponentEditor(ComponentClass: TComponentClass; - ComponentEditor: TComponentEditorClass); -begin - -end; - -initialization - DesignIntf.RegisterComponentEditorProc := LazRegisterComponentEditor; -finalization - DesignIntf.RegisterComponentEditorProc := nil; -end. - diff --git a/components/sparta/toolsapi/source/designintf.pas b/components/sparta/toolsapi/source/designintf.pas deleted file mode 100644 index 35c1769873..0000000000 --- a/components/sparta/toolsapi/source/designintf.pas +++ /dev/null @@ -1,220 +0,0 @@ -unit DesignIntf; - -{$WARNING Package Sparta_ToolsAPI is deprecated} -{$WARNING It will be removed from Lazarus sources in next major release} -{$mode objfpc}{$H+} - -interface - -uses - TypInfo, Classes, SysUtils, IniFiles, DesignMenus; - -type - // this one should be moved to Classes - TGetModuleProc = procedure(const FileName, UnitName, FormName, - DesignClass: string; CoClasses: TStrings) of object; - - IEventInfo = interface - ['{C3A5B0FD-37C6-486B-AD29-642C51928787}'] - function GetMethodKind: TMethodKind; - function GetParamCount: Integer; - function GetParamName(Index: Integer): string; - function GetParamType(Index: Integer): string; - function GetParamFlags(Index: Integer): TParamFlags; - function GetResultType: string; - end; - - IClass = interface - ['{94CD802C-3E83-4C38-AB36-1CD9DB196519}'] - function ClassNameIs(const AClassName: string): Boolean; - function GetClassName: string; - function GetUnitName: string; - function GetClassParent: IClass; - - property ClassName: string read GetClassName; - property ClassParent: IClass read GetClassParent; - property UnitName: string read GetUnitName; - end; - - IActivatable = interface - ['{F00AA4BD-3459-43E9-ACB2-97DBD1663AFF}'] - procedure Activate; - end; - - IDesignObject = interface - ['{B1648433-D671-4D5E-B49F-26740D4EB360}'] - function Equals(Obj: TObject): Boolean; overload; - function Equals(const ADesignObject: IDesignObject): Boolean; overload; - function GetClassType: IClass; - function GetClassName: string; - function GetComponentIndex: Integer; - function GetComponentName: string; - function GetIsComponent: Boolean; - function GetNamePath: string; - - property ClassType: IClass read GetClassType; - property ClassName: string read GetClassName; - property ComponentIndex: Integer read GetComponentIndex; - property ComponentName: string read GetComponentName; - property IsComponent: Boolean read GetIsComponent; - property NamePath: string read GetNamePath; - end; - - IDesignPersistent = interface(IDesignObject) - ['{8858E03D-5B6A-427A-BFFC-4A9B8198FB13}'] - function GetPersistent: TPersistent; - - property Persistent: TPersistent read GetPersistent; - end; - - IDesignerSelections = interface - ['{7ED7BF30-E349-11D3-AB4A-00C04FB17A72}'] - function Add(const Item: TPersistent): Integer; - function Equals(const List: IDesignerSelections): Boolean; - function Get(Index: Integer): TPersistent; - function GetDesignObject(Index: Integer): IDesignObject; - function GetCount: Integer; - property Count: Integer read GetCount; - property Items[Index: Integer]: TPersistent read Get; default; - property DesignObjects[Index: Integer]: IDesignObject read GetDesignObject; - end; - - IDesigner = interface; - IDesigner60 = interface - ['{A29C6480-D4AF-11D3-BA96-0080C78ADCDB}'] - procedure Activate; - procedure Modified; - function CreateMethod(const Name: string; TypeData: PTypeData): TMethod; overload; - function GetMethodName(const Method: TMethod): string; - procedure GetMethods(TypeData: PTypeData; Proc: TGetStrProc); overload; - function GetPathAndBaseExeName: string; - function GetPrivateDirectory: string; - function GetBaseRegKey: string; - function GetIDEOptions: TCustomIniFile; - procedure GetSelections(const List: IDesignerSelections); - function MethodExists(const Name: string): Boolean; - procedure RenameMethod(const CurName, NewName: string); - procedure SelectComponent(Instance: TPersistent); overload; - procedure SetSelections(const List: IDesignerSelections); - procedure ShowMethod(const Name: string); - procedure GetComponentNames(TypeData: PTypeData; Proc: TGetStrProc); - function GetComponent(const Name: string): TComponent; - function GetComponentName(Component: TComponent): string; - function GetObject(const Name: string): TPersistent; - function GetObjectName(Instance: TPersistent): string; - procedure GetObjectNames(TypeData: PTypeData; Proc: TGetStrProc); - function MethodFromAncestor(const Method: TMethod): Boolean; - function CreateComponent(ComponentClass: TComponentClass; Parent: TComponent; - Left, Top, Width, Height: Integer): TComponent; - function CreateCurrentComponent(Parent: TComponent; const Rect: TRect): TComponent; - function IsComponentLinkable(Component: TComponent): Boolean; - function IsComponentHidden(Component: TComponent): Boolean; - procedure MakeComponentLinkable(Component: TComponent); - procedure Revert(Instance: TPersistent; PropInfo: PPropInfo); - function GetIsDormant: Boolean; - procedure GetProjectModules(Proc: TGetModuleProc); - function GetAncestorDesigner: IDesigner; - function IsSourceReadOnly: Boolean; - function GetScrollRanges(const ScrollPosition: TPoint): TPoint; - procedure Edit(const Component: TComponent); - procedure ChainCall(const MethodName, InstanceName, InstanceMethod: string; - TypeData: PTypeData); overload; - procedure ChainCall(const MethodName, InstanceName, InstanceMethod: string; - const AEventInfo: IEventInfo); overload; - procedure CopySelection; - procedure CutSelection; - function CanPaste: Boolean; - procedure PasteSelection; - procedure DeleteSelection(ADoAll: Boolean = False); - procedure ClearSelection; - procedure NoSelection; - procedure ModuleFileNames(var ImplFileName, IntfFileName, FormFileName: string); - function GetRootClassName: string; - function UniqueName(const BaseName: string): string; - function GetRoot: TComponent; - function GetShiftState: TShiftState; - procedure ModalEdit(EditKey: Char; const ReturnWindow: IActivatable); - procedure SelectItemName(const PropertyName: string); - procedure Resurrect; - - property Root: TComponent read GetRoot; - property IsDormant: Boolean read GetIsDormant; - property AncestorDesigner: IDesigner read GetAncestorDesigner; - end; - - IDesigner70 = interface(IDesigner60) - ['{2F704CE2-7614-4AAF-B177-357D00D9634B}'] - function GetActiveClassGroup: TPersistentClass; - - function FindRootAncestor(const AClassName: string): TComponent; - property ActiveClassGroup: TPersistentClass read GetActiveClassGroup; - end; - - IDesigner80 = interface(IDesigner70) - ['{BCE34322-B22A-4494-BEA5-5B2B9754DE36}'] - function CreateMethod(const Name: string; const AEventInfo: IEventInfo): TMethod; overload; - procedure GetMethods(const AEventInfo: IEventInfo; Proc: TGetStrProc); overload; - procedure SelectComponent(const ADesignObject: IDesignObject); overload; - end; - - IDesigner100 = interface(IDesigner80) - ['{55501C77-FE8D-4844-A407-A7F90F7D5303}'] - function GetDesignerExtension: string; - - property DesignerExtention: string read GetDesignerExtension; - end; - - IDesigner = interface(IDesigner100) - ['{17ACD4A3-ED00-483E-8480-B5FBD4589440}'] - function GetAppDataDirectory(Local: Boolean = False): string; - end; - - IComponentEditor = interface - ['{ECACBA34-DCDF-4BE2-A645-E4404BC06106}'] - procedure Edit; - procedure ExecuteVerb(Index: Integer); - function GetVerb(Index: Integer): string; - function GetVerbCount: Integer; - procedure PrepareItem(Index: Integer; const AItem: IMenuItem); - procedure Copy; - function IsInInlined: Boolean; - function GetComponent: TComponent; - function GetDesigner: IDesigner; - end; - - { TBaseComponentEditor } - - TBaseComponentEditor = class(TInterfacedObject) - public - constructor Create(AComponent: TComponent; ADesigner: IDesigner); virtual; - end; - - TComponentEditorClass = class of TBaseComponentEditor; - TRegisterComponentEditorProc = procedure (ComponentClass: TComponentClass; - ComponentEditor: TComponentEditorClass); - -var - RegisterComponentEditorProc: TRegisterComponentEditorProc; - -procedure RegisterComponentEditor(ComponentClass: TComponentClass; - ComponentEditor: TComponentEditorClass); - -implementation - -procedure RegisterComponentEditor(ComponentClass: TComponentClass; - ComponentEditor: TComponentEditorClass); -begin - if Assigned(RegisterComponentEditorProc) then - RegisterComponentEditorProc(ComponentClass, ComponentEditor); -end; - -{ TBaseComponentEditor } - -constructor TBaseComponentEditor.Create(AComponent: TComponent; - ADesigner: IDesigner); -begin - inherited Create; -end; - -end. - diff --git a/components/sparta/toolsapi/source/designmenus.pas b/components/sparta/toolsapi/source/designmenus.pas deleted file mode 100644 index f44e046fe7..0000000000 --- a/components/sparta/toolsapi/source/designmenus.pas +++ /dev/null @@ -1,112 +0,0 @@ -unit DesignMenus; - -{$mode objfpc}{$H+} - -interface - -uses - Classes, SysUtils; - -type - IMenuItem = interface; - - IMenuItems = interface - ['{C9CC6C38-C96A-4514-8D6F-1D121727BFAF}'] - - function GetItem(Index: Integer): IMenuItem; - - function SameAs(const AItem: IUnknown): Boolean; - function Find(const ACaption: WideString): IMenuItem; - function FindByName(const AName: string): IMenuItem; - function Count: Integer; - property Items[Index: Integer]: IMenuItem read GetItem; - procedure Clear; - - function AddItem(const ACaption: WideString; AShortCut: TShortCut; - AChecked, AEnabled: Boolean; AOnClick: TNotifyEvent = nil; - hCtx: THelpContext = 0; const AName: string = ''): IMenuItem; overload; - - function AddItem(AAction: TBasicAction; - const AName: string = ''): IMenuItem; overload; - - function InsertItem(const ACaption: WideString; - AShortCut: TShortCut; AChecked, AEnabled: Boolean; AOnClick: TNotifyEvent = nil; - hCtx: THelpContext = 0; const AName: string = ''): IMenuItem; overload; - function InsertItem(Index: Integer; const ACaption: WideString; - AShortCut: TShortCut; AChecked, AEnabled: Boolean; AOnClick: TNotifyEvent = nil; - hCtx: THelpContext = 0; const AName: string = ''): IMenuItem; overload; - - function InsertItem(AAction: TBasicAction; - const AName: string = ''): IMenuItem; overload; - function InsertItem(Index: Integer; AAction: TBasicAction; - const AName: string = ''): IMenuItem; overload; - - function AddLine(const AName: string = ''): IMenuItem; - - function InsertLine(const AName: string = ''): IMenuItem; overload; - function InsertLine(Index: Integer; const AName: string = ''): IMenuItem; overload; - end; - - IMenu = interface - ['{0993FAE4-17E2-4EB7-81DF-26634D7F9E16}'] - function Items: IMenuItems; - end; - - IMainMenu = interface(IMenu) - ['{5D137DC1-73F4-48CB-8351-E14A369AE924}'] - end; - - IPopupMenu = interface(IMenu) - ['{E2E9ED8C-4D54-482B-AC62-23F1CEBFE414}'] - - procedure Popup(X, Y: Integer); - function PopupComponent: TComponent; - end; - - IMenuItem = interface(IMenuItems) - ['{DAF029E1-9592-4B07-A450-A10056A2B9B5}'] - - function GetCaption: WideString; - procedure SetCaption(const ACaption: WideString); - function GetChecked: Boolean; - procedure SetChecked(AChecked: Boolean); - function GetEnabled: Boolean; - procedure SetEnabled(AEnabled: Boolean); - function GetGroupIndex: Byte; - procedure SetGroupIndex(AGroupIndex: Byte); - function GetHelpContext: THelpContext; - procedure SetHelpContext(AHelpContext: THelpContext); - function GetHint: string; - procedure SetHint(const AHint: string); - function GetRadioItem: Boolean; - procedure SetRadioItem(ARadioItem: Boolean); - function GetShortCut: TShortCut; - procedure SetShortCut(AShortCut: TShortCut); - function GetTag: LongInt; - procedure SetTag(AValue: LongInt); - function GetVisible: Boolean; - procedure SetVisible(AVisible: Boolean); - - // public - function Name: TComponentName; - function MenuIndex: Integer; - function Parent: IMenuItem; - function HasParent: Boolean; - function IsLine: Boolean; - - property Caption: WideString read GetCaption write SetCaption; - property Checked: Boolean read GetChecked write SetChecked; - property Enabled: Boolean read GetEnabled write SetEnabled; - property GroupIndex: Byte read GetGroupIndex write SetGroupIndex; - property HelpContext: THelpContext read GetHelpContext write SetHelpContext; - property Hint: string read GetHint write SetHint; - property RadioItem: Boolean read GetRadioItem write SetRadioItem; - property ShortCut: TShortCut read GetShortCut write SetShortCut; - property Tag: LongInt read GetTag write SetTag; - property Visible: Boolean read GetVisible write SetVisible; - end; - -implementation - -end. - diff --git a/components/sparta/toolsapi/sparta_toolsapi.lpk b/components/sparta/toolsapi/sparta_toolsapi.lpk deleted file mode 100644 index ec4351a185..0000000000 --- a/components/sparta/toolsapi/sparta_toolsapi.lpk +++ /dev/null @@ -1,47 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/components/sparta/toolsapi/sparta_toolsapi.pas b/components/sparta/toolsapi/sparta_toolsapi.pas deleted file mode 100644 index da98f911b2..0000000000 --- a/components/sparta/toolsapi/sparta_toolsapi.pas +++ /dev/null @@ -1,20 +0,0 @@ -{ This file was automatically created by Lazarus. Do not edit! - This source is only used to compile and install the package. - } - -unit sparta_ToolsAPI; - -interface - -uses - DesignIntf, DesignEditors, DesignMenus, LazarusPackageIntf; - -implementation - -procedure Register; -begin -end; - -initialization - RegisterPackage('sparta_ToolsAPI', @Register); -end. diff --git a/packager/globallinks/sparta_dockedformeditor-0.lpl b/packager/globallinks/sparta_dockedformeditor-0.lpl deleted file mode 100644 index c194911255..0000000000 --- a/packager/globallinks/sparta_dockedformeditor-0.lpl +++ /dev/null @@ -1 +0,0 @@ -$(LazarusDir)/components/sparta/dockedformeditor/sparta_dockedformeditor.lpk diff --git a/packager/globallinks/sparta_mdi-0.lpl b/packager/globallinks/sparta_mdi-0.lpl deleted file mode 100644 index b85cc344f8..0000000000 --- a/packager/globallinks/sparta_mdi-0.lpl +++ /dev/null @@ -1 +0,0 @@ -$(LazarusDir)/components/sparta/mdi/sparta_mdi.lpk diff --git a/packager/globallinks/sparta_smartformeditor-0.lpl b/packager/globallinks/sparta_smartformeditor-0.lpl deleted file mode 100644 index ef26398845..0000000000 --- a/packager/globallinks/sparta_smartformeditor-0.lpl +++ /dev/null @@ -1 +0,0 @@ -$(LazarusDir)/components/sparta/smartformeditor/sparta_smartformeditor.lpk diff --git a/packager/globallinks/sparta_toolsapi-0.lpl b/packager/globallinks/sparta_toolsapi-0.lpl deleted file mode 100644 index 06607a0c15..0000000000 --- a/packager/globallinks/sparta_toolsapi-0.lpl +++ /dev/null @@ -1 +0,0 @@ -$(LazarusDir)/components/sparta/toolsapi/sparta_toolsapi.lpk