paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2026-01-07 06:50:36 +01:00
Code Issues Packages Projects Releases Wiki Activity

Packages: removed deprecated Sparta packages which started to cause troubles to users, issue 40485

Browse Source
This commit is contained in:
Maxim Ganetsky 2023-09-05 03:17:44 +03:00
parent 7828e0eb7c
commit 2516749a2f
55 changed files with 0 additions and 9276 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
components/sparta/dockedformeditor/language/sparta_strconsts.fr.po
View File

@ -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 <gillesvasseur58@gmail.com>\n"
"Language-Team: Vasseur Gilles <gillesvasseur58@gmail.com>\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"

23
components/sparta/dockedformeditor/language/sparta_strconsts.hu.po
View File

@ -1,23 +0,0 @@
msgid ""
msgstr ""
"Project-Id-Version: \n"
"POT-Creation-Date: \n"
"PO-Revision-Date: \n"
"Last-Translator: Péter Gábor <ptrg@freemail.hu>\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ő"

24
components/sparta/dockedformeditor/language/sparta_strconsts.lt.po
View File

@ -1,24 +0,0 @@
# Valdas Jankunas <zmuogs@gmail.com>, 2017.
msgid ""
msgstr ""
"Last-Translator: Valdas Jankunas <zmuogs@gmail.com>\n"
"PO-Revision-Date: 2017-07-05 20:56+0200\n"
"Project-Id-Version: \n"
"Language-Team: Lithuanian <kde-i18n-lt@kde.org>\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"

13
components/sparta/dockedformeditor/language/sparta_strconsts.pot
View File

@ -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 ""

23
components/sparta/dockedformeditor/language/sparta_strconsts.pt_BR.po
View File

@ -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 <marcelo.bp@netsite.com.br>\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"

23
components/sparta/dockedformeditor/language/sparta_strconsts.ru.po
View File

@ -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 <maxkill@mail.ru>\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 "Дизайнер"

23
components/sparta/dockedformeditor/language/sparta_strconsts.tr.po
View File

@ -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 <onur2x@gmail.com>\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"

23
components/sparta/dockedformeditor/language/sparta_strconsts.uk.po
View File

@ -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 <maxkill@mail.ru>\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 "Дизайнер"

24
components/sparta/dockedformeditor/language/sparta_strconsts.zh_CN.po
View File

@ -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 <robsean@126.com>\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 "设计"

56
components/sparta/dockedformeditor/source/sparta_designedform.pas
View File

@ -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.

744
components/sparta/dockedformeditor/source/sparta_fakecustom.pas
View File

@ -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.

274
components/sparta/dockedformeditor/source/sparta_fakeform.pas
View File

@ -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.

134
components/sparta/dockedformeditor/source/sparta_fakeframe.pas
View File

@ -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.

29
components/sparta/dockedformeditor/source/sparta_fakenoncontrol.pas
View File

@ -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.

1360
components/sparta/dockedformeditor/source/sparta_mainide.pas
View File

File diff suppressed because it is too large Load Diff

73
components/sparta/dockedformeditor/source/sparta_reg_dockedformeditor.pas
View File

@ -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.

99
components/sparta/dockedformeditor/source/sparta_resizer.pas
View File

@ -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.

16
components/sparta/dockedformeditor/source/sparta_resizerframe.lfm
View File

@ -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

96
components/sparta/dockedformeditor/source/sparta_resizerframe.pas
View File

@ -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.

117
components/sparta/dockedformeditor/source/spartaapi.pas
View File

@ -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.

92
components/sparta/dockedformeditor/sparta_dockedformeditor.lpk
View File

@ -1,92 +0,0 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<Package Version="4">
<PathDelim Value="\"/>
<Name Value="sparta_DockedFormEditor"/>
<Type Value="RunAndDesignTime"/>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<SearchPaths>
<IncludeFiles Value="source"/>
<OtherUnitFiles Value="source"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)\$(LCLWidgetType)"/>
</SearchPaths>
<Linking>
<Debugging>
<UseValgrind Value="True"/>
<UseExternalDbgSyms Value="True"/>
</Debugging>
</Linking>
<Other>
<CustomOptions Value="$(IDEBuildOptions)"/>
</Other>
</CompilerOptions>
<Files Count="11">
<Item1>
<Filename Value="source\sparta_reg_dockedformeditor.pas"/>
<HasRegisterProc Value="True"/>
<UnitName Value="sparta_reg_DockedFormEditor"/>
</Item1>
<Item2>
<Filename Value="source\sparta_designedform.pas"/>
<UnitName Value="sparta_DesignedForm"/>
</Item2>
<Item3>
<Filename Value="source\sparta_resizer.pas"/>
<UnitName Value="sparta_Resizer"/>
</Item3>
<Item4>
<Filename Value="source\sparta_resizerframe.pas"/>
<UnitName Value="sparta_ResizerFrame"/>
</Item4>
<Item5>
<Filename Value="source\spartaapi.pas"/>
<UnitName Value="SpartaAPI"/>
</Item5>
<Item6>
<Filename Value="source\sparta_fakecustom.pas"/>
<UnitName Value="sparta_FakeCustom"/>
</Item6>
<Item7>
<Filename Value="source\sparta_fakeform.pas"/>
<UnitName Value="sparta_FakeForm"/>
</Item7>
<Item8>
<Filename Value="source\sparta_fakeframe.pas"/>
<UnitName Value="sparta_FakeFrame"/>
</Item8>
<Item9>
<Filename Value="source\sparta_fakenoncontrol.pas"/>
<UnitName Value="sparta_FakeNonControl"/>
</Item9>
<Item10>
<Filename Value="source\sparta_mainide.pas"/>
<UnitName Value="sparta_MainIDE"/>
</Item10>
<Item11>
<Filename Value="sparta_strconsts.pas"/>
<UnitName Value="sparta_strconsts"/>
</Item11>
</Files>
<i18n>
<EnableI18N Value="True"/>
<OutDir Value="language"/>
<EnableI18NForLFM Value="True"/>
</i18n>
<RequiredPkgs Count="2">
<Item1>
<PackageName Value="sparta_MDI"/>
</Item1>
<Item2>
<PackageName Value="IDEIntf"/>
</Item2>
</RequiredPkgs>
<UsageOptions>
<UnitPath Value="$(PkgOutDir)"/>
</UsageOptions>
<PublishOptions>
<Version Value="2"/>
</PublishOptions>
</Package>
</CONFIG>

26
components/sparta/dockedformeditor/sparta_dockedformeditor.pas
View File

@ -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.

14
components/sparta/dockedformeditor/sparta_strconsts.pas
View File

@ -1,14 +0,0 @@
unit sparta_strconsts;
{$mode objfpc}{$H+}
interface
resourcestring
SCode = 'Code';
SDesigner = 'Designer';
implementation
end.

384
components/sparta/mdi/source/sparta_abstractresizer.pas
View File

@ -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.

548
components/sparta/mdi/source/sparta_basicfakecustom.pas
View File

@ -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.

216
components/sparta/mdi/source/sparta_basicresizeframe.lfm
View File

@ -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

1147
components/sparta/mdi/source/sparta_basicresizeframe.pas
View File

File diff suppressed because it is too large Load Diff

152
components/sparta/mdi/source/sparta_basicresizer.pas
View File

@ -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.

27
components/sparta/mdi/source/sparta_formbackgroundformdi.lfm
View File

@ -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

133
components/sparta/mdi/source/sparta_formbackgroundformdi.pas
View File

@ -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.

171
components/sparta/mdi/source/sparta_interfacesmdi.pas
View File

@ -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.

209
components/sparta/mdi/source/sparta_multiplyresizer.pas
View File

@ -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<IDesignedForm, TMultiplyResizer>;
class constructor Create;
class destructor Destroy;
class procedure OnUserInputHandler(Sender: TObject; Msg: Cardinal);
private
FFormsStack: TList<IDesignedForm>;
FForms: TObjectDictionary<IDesignedForm, TResizerRec>;
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<IDesignedForm, TMultiplyResizer>.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<IDesignedForm, TResizerRec>.Create([doOwnsValues]);
FFormsStack := TList<IDesignedForm>.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.

64
components/sparta/mdi/sparta_mdi.lpk
View File

@ -1,64 +0,0 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<Package Version="4">
<PathDelim Value="\"/>
<Name Value="sparta_MDI"/>
<Type Value="RunAndDesignTime"/>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<SearchPaths>
<OtherUnitFiles Value="source"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
</CompilerOptions>
<Files Count="8">
<Item1>
<Filename Value="source\sparta_basicresizeframe.pas"/>
<UnitName Value="sparta_BasicResizeFrame"/>
</Item1>
<Item2>
<Filename Value="source\sparta_interfacesmdi.pas"/>
<UnitName Value="sparta_InterfacesMDI"/>
</Item2>
<Item3>
<Filename Value="source\sparta_basicresizer.pas"/>
<UnitName Value="sparta_BasicResizer"/>
</Item3>
<Item4>
<Filename Value="sparta_mdi_strconsts.pas"/>
<UnitName Value="sparta_MDI_StrConsts"/>
</Item4>
<Item5>
<Filename Value="source\sparta_basicfakecustom.pas"/>
<UnitName Value="sparta_BasicFakeCustom"/>
</Item5>
<Item6>
<Filename Value="source\sparta_formbackgroundformdi.pas"/>
<UnitName Value="sparta_FormBackgroundForMDI"/>
</Item6>
<Item7>
<Filename Value="source\sparta_multiplyresizer.pas"/>
<UnitName Value="sparta_MultiplyResizer"/>
</Item7>
<Item8>
<Filename Value="source\sparta_abstractresizer.pas"/>
<UnitName Value="sparta_abstractresizer"/>
</Item8>
</Files>
<RequiredPkgs Count="2">
<Item2>
<PackageName Value="LCL"/>
</Item2>
<Item1>
<PackageName Value="FCL"/>
</Item1>
</RequiredPkgs>
<UsageOptions>
<UnitPath Value="$(PkgOutDir)"/>
</UsageOptions>
<PublishOptions>
<Version Value="2"/>
</PublishOptions>
</Package>
</CONFIG>

22
components/sparta/mdi/sparta_mdi.pas
View File

@ -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.

13
components/sparta/mdi/sparta_mdi_strconsts.pas
View File

@ -1,13 +0,0 @@
unit sparta_MDI_StrConsts;
{$mode objfpc}{$H+}
interface
resourcestring
SArgumentOutOfRange = 'Argument out of range';
implementation
end.

BIN
components/sparta/smartformeditor/source/sparta.res
View File

Binary file not shown.

619
components/sparta/smartformeditor/source/sparta_componentpalette.pas
View File

@ -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<TTabSheet, TPageData>;
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<TControl>;
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<TControl>.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<TTabSheet, TPageData>.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.

106
components/sparta/smartformeditor/source/sparta_edtu_main.lfm
View File

@ -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

274
components/sparta/smartformeditor/source/sparta_edtu_main.pas
View File

@ -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.

226
components/sparta/smartformeditor/source/sparta_fakeformbackground.lfm
View File

@ -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

435
components/sparta/smartformeditor/source/sparta_fakeformbackground.pas
View File

@ -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.

BIN
components/sparta/smartformeditor/source/sparta_fakeformbackground.res
View File

Binary file not shown.

60
components/sparta/smartformeditor/source/sparta_fakeformbg.pas
View File

@ -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.

69
components/sparta/smartformeditor/source/sparta_reg_smartformeditor.pas
View File

@ -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.

53
components/sparta/smartformeditor/sparta_smartformeditor.lpk
View File

@ -1,53 +0,0 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<Package Version="4">
<PathDelim Value="\"/>
<Name Value="sparta_SmartFormEditor"/>
<Type Value="RunAndDesignTime"/>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<SearchPaths>
<OtherUnitFiles Value="source"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)\$(LCLWidgetType)"/>
</SearchPaths>
<Other>
<CustomOptions Value="$(IDEBuildOptions)"/>
</Other>
</CompilerOptions>
<Files Count="5">
<Item1>
<Filename Value="source\sparta_reg_smartformeditor.pas"/>
<HasRegisterProc Value="True"/>
<UnitName Value="sparta_reg_SmartFormEditor"/>
</Item1>
<Item2>
<Filename Value="source\sparta_fakeformbackground.pas"/>
<UnitName Value="sparta_FakeFormBackground"/>
</Item2>
<Item3>
<Filename Value="source\sparta_fakeformbg.pas"/>
<UnitName Value="sparta_fakeformbg"/>
</Item3>
<Item4>
<Filename Value="source\sparta_edtu_main.pas"/>
<UnitName Value="sparta_EDTU_Main"/>
</Item4>
<Item5>
<Filename Value="source\sparta_componentpalette.pas"/>
<UnitName Value="sparta_ComponentPalette"/>
</Item5>
</Files>
<RequiredPkgs Count="1">
<Item1>
<PackageName Value="sparta_DockedFormEditor"/>
</Item1>
</RequiredPkgs>
<UsageOptions>
<UnitPath Value="$(PkgOutDir)"/>
</UsageOptions>
<PublishOptions>
<Version Value="2"/>
</PublishOptions>
</Package>
</CONFIG>

23
components/sparta/smartformeditor/sparta_smartformeditor.pas
View File

@ -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.

592
components/sparta/toolsapi/source/designeditors.pas
View File

@ -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.

220
components/sparta/toolsapi/source/designintf.pas
View File

@ -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.

112
components/sparta/toolsapi/source/designmenus.pas
View File

@ -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.

47
components/sparta/toolsapi/sparta_toolsapi.lpk
View File

@ -1,47 +0,0 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<Package Version="4">
<PathDelim Value="\"/>
<Name Value="sparta_ToolsAPI"/>
<Type Value="RunAndDesignTime"/>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<SearchPaths>
<OtherUnitFiles Value="source"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)\"/>
</SearchPaths>
</CompilerOptions>
<Files Count="3">
<Item1>
<Filename Value="source\designintf.pas"/>
<UnitName Value="DesignIntf"/>
</Item1>
<Item2>
<Filename Value="source\designeditors.pas"/>
<UnitName Value="DesignEditors"/>
</Item2>
<Item3>
<Filename Value="source\designmenus.pas"/>
<UnitName Value="DesignMenus"/>
</Item3>
</Files>
<RequiredPkgs Count="3">
<Item1>
<PackageName Value="sparta_Generics"/>
</Item1>
<Item2>
<PackageName Value="IDEIntf"/>
</Item2>
<Item3>
<PackageName Value="FCL"/>
</Item3>
</RequiredPkgs>
<UsageOptions>
<UnitPath Value="$(PkgOutDir)"/>
</UsageOptions>
<PublishOptions>
<Version Value="2"/>
</PublishOptions>
</Package>
</CONFIG>

20
components/sparta/toolsapi/sparta_toolsapi.pas
View File

@ -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.

1
packager/globallinks/sparta_dockedformeditor-0.lpl
View File

@ -1 +0,0 @@
$(LazarusDir)/components/sparta/dockedformeditor/sparta_dockedformeditor.lpk

1
packager/globallinks/sparta_mdi-0.lpl
View File

@ -1 +0,0 @@
$(LazarusDir)/components/sparta/mdi/sparta_mdi.lpk

1
packager/globallinks/sparta_smartformeditor-0.lpl
View File

@ -1 +0,0 @@
$(LazarusDir)/components/sparta/smartformeditor/sparta_smartformeditor.lpk

1
packager/globallinks/sparta_toolsapi-0.lpl
View File

@ -1 +0,0 @@
$(LazarusDir)/components/sparta/toolsapi/sparta_toolsapi.lpk