paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-09 19:08:03 +02:00
Code Issues Packages Projects Releases Wiki Activity

implemented datamodules

Browse Source 
git-svn-id: trunk@4222 -
This commit is contained in:
mattias 2003-06-01 21:09:09 +00:00
parent fc6f9fdd12
commit ec9835ce63
14 changed files with 407 additions and 112 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

133
components/codetools/basiccodetools.pas
View File

@ -122,8 +122,7 @@ procedure RaiseCatchableException(const Msg: string);
// functions / procedures
{ These functions are not context sensitive. Especially they ignore compiler
settings and compiler directives. They exist only for easy usage, they are not
used by the CodeTools
settings and compiler directives. They exist only for basic usage.
}
// source type
@ -197,14 +196,15 @@ function AddFormComponentToSource(Source:TSourceLog; FormBodyStartPos: integer;
function RemoveFormComponentFromSource(Source:TSourceLog;
FormBodyStartPos: integer;
ComponentName, ComponentClassName: string): boolean;
function FindClassAncestorName(const Source, FormClassName: string): string;
// code search
function SearchCodeInSource(const Source,Find:string; StartPos:integer;
var EndFoundPosition:integer; CaseSensitive:boolean):integer;
function ReadNextPascalAtom(const Source:string;
var Position,AtomStart:integer):string;
function ReadRawNextPascalAtom(const Source:string;
var Position,AtomStart:integer):string;
function SearchCodeInSource(const Source, Find: string; StartPos:integer;
var EndFoundPosition: integer; CaseSensitive: boolean):integer;
function ReadNextPascalAtom(const Source: string;
var Position, AtomStart: integer): string;
procedure ReadRawNextPascalAtom(const Source: string;
var Position, AtomStart: integer);
//-----------------------------------------------------------------------------
@ -901,67 +901,86 @@ begin
Result:=true;
end;
function ReadNextPascalAtomEx(const Source : string;var Position,EndPosition : integer;CaseSensitive : boolean; var Atom : string):boolean;
function FindClassAncestorName(const Source, FormClassName: string): string;
var
SrcPos, AtomStart: integer;
begin
Atom := ReadNextPascalAtom(Source,Position,EndPosition);
if not(CaseSensitive) then Atom := lowerCase(Atom);
Result := (Position > length(Source));
Result:='';
if SearchCodeInSource(Source,FormClassName+'=class(',1,SrcPos,false)<1 then
exit;
Result:=ReadNextPascalAtom(Source,SrcPos,AtomStart);
if (Result<>'') and (not IsValidIdent(Result)) then
Result:='';
end;
function SearchCodeInSource(const Source, Find: string; StartPos: integer;
var EndFoundPosition: integer; CaseSensitive: boolean):integer;
// search pascal atoms of Find in Source
function SearchCodeInSource(const Source,Find:string; StartPos:integer;
var EndFoundPosition:integer; CaseSensitive:boolean):integer;
// returns the start pos
var
FindAtomStart : integer;
FindPos : integer;
Position : integer;
AtomStart : integer;
FirstSrcAtomStart : integer;
CompareSrcPosition: integer;
FindAtom : string ;
SrcAtom : string;
HasFound : boolean;
FirstFindAtom : string;
FirstFindPos : integer;
FindLen: Integer;
SrcLen: Integer;
Position: Integer;
FirstFindPos: Integer;
FindAtomStart: Integer;
AtomStart: Integer;
FindAtomLen: Integer;
AtomLen: Integer;
SrcPos: Integer;
FindPos: Integer;
SrcAtomStart: Integer;
FirstFindAtomStart: Integer;
begin
Result:=-1;
if (Find='') or (StartPos>length(Source)) then exit;
FindLen:=length(Find);
SrcLen:=length(Source);
Position:=StartPos;
AtomStart:=StartPos;
FirstFindPos:=1;
FirstFindAtomStart:=1;
{search first atom in find}
if ReadNextPascalAtomEx(Find,FirstFindPos,FindAtomStart,CaseSensitive,FirstFindAtom) then exit;
// search first atom in find
ReadRawNextPascalAtom(Find,FirstFindPos,FirstFindAtomStart);
FindAtomLen:=FirstFindPos-FirstFindAtomStart;
if FirstFindAtomStart>FindLen then exit;
repeat
if ReadNextPascalAtomEx(Source,Position,AtomStart,CaseSensitive,SrcAtom) then break;
if SrcAtom=FirstFindAtom then begin
{first atom found}
FirstSrcAtomStart := AtomStart;
CompareSrcPosition := Position;
FindPos := FirstFindPos;
{read next source and find atoms and compare}
// read next atom
ReadRawNextPascalAtom(Source,Position,AtomStart);
if AtomStart>SrcLen then exit;
AtomLen:=Position-AtomStart;
if (AtomLen=FindAtomLen)
and (CompareText(@Find[FirstFindAtomStart],FindAtomLen,
@Source[AtomStart],AtomLen,CaseSensitive)=0)
then begin
// compare all atoms
SrcPos:=Position;
SrcAtomStart:=SrcPos;
FindPos:=FirstFindPos;
FindAtomStart:=FindPos;
repeat
if ReadNextPascalAtomEx(Find,FindPos,FindAtomStart,CaseSensitive,FindAtom) then break;
if ReadNextPascalAtomEx(Source,CompareSrcPosition,AtomStart,CaseSensitive,SrcAtom) then break;
HasFound := SrcAtom = FindAtom;
if HasFound then begin
Result := FirstSrcAtomStart;
EndFoundPosition := CompareSrcPosition;
exit;
// read the next atom from the find
ReadRawNextPascalAtom(Find,FindPos,FindAtomStart);
if FindAtomStart>FindLen then begin
// found !
EndFoundPosition:=SrcPos;
Result:=AtomStart;
exit;
end;
until not(HasFound);
end;
// read the next atom from the source
ReadRawNextPascalAtom(Source,SrcPos,SrcAtomStart);
// compare
if (CompareText(@Find[FindAtomStart],FindPos-FindAtomStart,
@Source[SrcAtomStart],SrcPos-SrcAtomStart,
CaseSensitive)<>0)
then
break;
until false;
end;
until false;
end;
@ -1156,7 +1175,8 @@ var DirectiveName:string;
DirStart,DirEnd,EndPos:integer;
begin
repeat
Result:=ReadRawNextPascalAtom(Source,Position,AtomStart);
ReadRawNextPascalAtom(Source,Position,AtomStart);
Result:=copy(Source,AtomStart,Position-AtomStart);
if (copy(Result,1,2)='{$') or (copy(Result,1,3)='(*$') then begin
if copy(Result,1,2)='{$' then begin
DirStart:=3;
@ -1181,8 +1201,8 @@ begin
until false;
end;
function ReadRawNextPascalAtom(const Source:string;
var Position,AtomStart:integer):string;
procedure ReadRawNextPascalAtom(const Source:string;
var Position,AtomStart:integer);
var Len:integer;
c1,c2:char;
begin
@ -1328,7 +1348,6 @@ begin
end;
end;
end;
Result:=copy(Source,AtomStart,Position-AtomStart);
end;
function LineEndCount(const Txt: string;

24
components/codetools/codetoolmanager.pas
View File

@ -368,6 +368,8 @@ type
function RenameForm(Code: TCodeBuffer;
const OldFormName, OldFormClassName: string;
const NewFormName, NewFormClassName: string): boolean;
function FindFormAncestor(Code: TCodeBuffer; const FormClassName: string;
var AncestorClassName: string; DirtySearch: boolean): boolean;
// form components
function PublishedVariableExists(Code: TCodeBuffer;
@ -1970,6 +1972,28 @@ begin
end;
end;
function TCodeToolManager.FindFormAncestor(Code: TCodeBuffer;
const FormClassName: string; var AncestorClassName: string;
DirtySearch: boolean): boolean;
begin
Result:=false;
{$IFDEF CTDEBUG}
writeln('TCodeToolManager.FindFormAncestor A ',Code.Filename,' ',FormClassName);
{$ENDIF}
AncestorClassName:='';
if not InitCurCodeTool(Code) then exit;
try
Result:=FCurCodeTool.FindFormAncestor(UpperCaseStr(FormClassName),
AncestorClassName);
except
on e: Exception do Result:=HandleException(e);
end;
if (not Result) and DirtySearch then begin
AncestorClassName:=FindClassAncestorName(Code.Source,FormClassName);
Result:=AncestorClassName<>'';
end;
end;
function TCodeToolManager.PublishedVariableExists(Code: TCodeBuffer;
const AClassName, AVarName: string): boolean;
begin

28
components/codetools/stdcodetools.pas
View File

@ -128,6 +128,8 @@ type
function RenameForm(const OldFormName, OldFormClassName: string;
const NewFormName, NewFormClassName: string;
SourceChangeCache: TSourceChangeCache): boolean;
function FindFormAncestor(const UpperClassName: string;
var AncestorClassName: string): boolean;
// form components
function FindPublishedVariable(const UpperClassName,
@ -1135,6 +1137,32 @@ begin
end;
end;
function TStandardCodeTool.FindFormAncestor(const UpperClassName: string;
var AncestorClassName: string): boolean;
var
ClassNode: TCodeTreeNode;
begin
Result:=false;
AncestorClassName:='';
if UpperClassName='' then exit;
BuildTree(true);
ClassNode:=FindClassNodeInInterface(UpperClassName,true,false);
if (ClassNode=nil) then exit;
// search the ancestor name
MoveCursorToNodeStart(ClassNode);
ReadNextAtom; // read keyword 'class', 'object', 'interface', 'dispinterface'
if UpAtomIs('PACKED') then ReadNextAtom;
ReadNextAtom;
if AtomIsChar('(') then begin
ReadNextAtom;
if AtomIsIdentifier(false) then
AncestorClassName:=GetAtom;
end;
if AncestorClassName='' then
AncestorClassName:='TObject';
Result:=true;
end;
{-------------------------------------------------------------------------------
function TStandardCodeTool.ReplaceIdentifiers(IdentList: TStrings;
SourceChangeCache: TSourceChangeCache): boolean;

21
designer/designerprocs.pas
View File

@ -81,14 +81,6 @@ const
NonVisualCompWidth = NonVisualCompIconWidth+2*NonVisualCompBorder;
type
TGetDesignerFormEvent =
function(AComponent: TComponent): TCustomForm of object;
var
OnGetDesignerForm: TGetDesignerFormEvent;
function GetDesignerForm(AComponent: TComponent): TCustomForm;
function GetParentLevel(AControl: TControl): integer;
function ControlIsInDesignerVisible(AControl: TControl): boolean;
function ComponentIsInvisible(AComponent: TComponent): boolean;
@ -277,19 +269,6 @@ begin
Result:=(AComponent is TMenuItem);
end;
function GetDesignerForm(AComponent: TComponent): TCustomForm;
var
Owner: TComponent;
begin
Result:=nil;
if Assigned(OnGetDesignerForm) then
Result:=OnGetDesignerForm(AComponent)
else begin
Owner:=AComponent.Owner;
if Owner is TCustomForm then Result:=TCustomForm(Owner);
end;
end;
{ TDesignerDeviceContext }
function TDesignerDeviceContext.GetDCOrigin: TPoint;

13
designer/jitform/jitform.pas
View File

@ -57,6 +57,8 @@ type
TJITDataModule = class (TDataModule)
protected
class function NewInstance : TObject; override;
procedure ValidateRename(AComponent: TComponent;
const CurName, NewName: string); override;
public
end;
@ -111,5 +113,16 @@ begin
TSetDesigningComponent.SetDesigningOfControl(TComponent(Result),true);
end;
procedure TJITDataModule.ValidateRename(AComponent: TComponent; const CurName,
NewName: string);
var
Designer: TIDesigner;
begin
inherited ValidateRename(AComponent, CurName, NewName);
Designer:=FindRootDesigner(Self);
if Designer <> nil then
Designer.ValidateRename(AComponent, CurName, NewName);
end;
end.

14
designer/noncontrolforms.pas
View File

@ -109,6 +109,10 @@ begin
if FLookupRoot=AValue then exit;
DoSaveBounds;
FLookupRoot:=AValue;
if FLookupRoot<>nil then begin
Caption:=FLookupRoot.Name;
writeln('TNonControlForm.SetLookupRoot ',FLookupRoot.Name,':',FLookupRoot.ClassName);
end;
DoLoadBounds;
end;
@ -124,10 +128,12 @@ begin
inherited Create(TheOwner);
FFrameWidth:=1;
ControlStyle:=ControlStyle-[csAcceptsControls];
writeln('TNonControlForm.Create ');
end;
destructor TNonControlForm.Destroy;
begin
writeln('TNonControlForm.Destroy ');
inherited Destroy;
end;
@ -136,11 +142,13 @@ var
ARect: TRect;
begin
inherited Paint;
ARect:=Rect(FrameWidth,FrameWidth,
ClientWidth-FrameWidth,ClientHeight-FrameWidth);
with Canvas do begin
Brush.Color:=clWhite;
ARect:=Rect(FrameWidth,FrameWidth,
ClientWidth-FrameWidth,ClientHeight-FrameWidth);
FillRect(ARect);
ARect:=Rect(0,0,ClientWidth+1,ClientHeight+1);
Pen.Color:=clBlack;
Frame3d(ARect, FrameWidth, bvLowered);
end;
end;
@ -191,6 +199,7 @@ begin
NewTop:=CurDataModule.DesignOffset.Y;
NewWidth:=CurDataModule.DesignSize.X;
NewHeight:=CurDataModule.DesignSize.Y;
writeln('TDataModuleForm.DoLoadBounds ',NewLeft,',',NewTop,',',NewWidth,',',NewHeight);
SetBounds(NewLeft,NewTop,NewWidth,NewHeight);
end;
end;
@ -205,6 +214,7 @@ begin
CurDataModule.DesignOffset.Y:=Top;
CurDataModule.DesignSize.X:=Width;
CurDataModule.DesignSize.Y:=Height;
writeln('TDataModuleForm.DoSaveBounds ',Left,',',Top,',',Width,',',Height);
end;
inherited DoSaveBounds;
end;

38
designer/propedits.pp
View File

@ -905,6 +905,9 @@ type
TPropHookGetComponentNames = procedure(TypeData:PTypeData;
Proc:TGetStringProc) of object;
TPropHookGetRootClassName = function:ShortString of object;
TPropHookBeforeAddComponent = function(Sender: TObject;
AComponentClass: TComponentClass;
Parent: TComponent): boolean of object;
TPropHookComponentRenamed = procedure(AComponent: TComponent) of object;
TPropHookComponentAdded = procedure(AComponent: TComponent; Select: boolean
) of object;
@ -940,6 +943,7 @@ type
htGetComponentNames,
htGetRootClassName,
htComponentRenamed,
htBeforeAddComponent,
htComponentAdded,
htComponentDeleting,
htDeleteComponent,
@ -989,6 +993,9 @@ type
function GetComponentName(AComponent: TComponent):ShortString;
procedure GetComponentNames(TypeData:PTypeData; const Proc:TGetStringProc);
function GetRootClassName:ShortString;
function BeforeAddComponent(Sender: TObject;
AComponentClass: TComponentClass;
Parent: TComponent): boolean;
procedure ComponentRenamed(AComponent: TComponent);
procedure ComponentAdded(AComponent: TComponent; Select: boolean);
procedure ComponentDeleting(AComponent: TComponent);
@ -1045,6 +1052,10 @@ type
OnGetRootClassName: TPropHookGetRootClassName);
procedure RemoveHandlerGetRootClassName(
OnGetRootClassName: TPropHookGetRootClassName);
procedure AddHandlerBeforeAddComponent(
OnBeforeAddComponent: TPropHookBeforeAddComponent);
procedure RemoveHandlerBeforeAddComponent(
OnBeforeAddComponent: TPropHookBeforeAddComponent);
procedure AddHandlerComponentRenamed(
OnComponentRenamed: TPropHookComponentRenamed);
procedure RemoveHandlerComponentRenamed(
@ -4380,6 +4391,21 @@ begin
Result:=LookupRoot.ClassName;
end;
function TPropertyEditorHook.BeforeAddComponent(Sender: TObject;
AComponentClass: TComponentClass; Parent: TComponent): boolean;
var
i: Integer;
Handler: TPropHookBeforeAddComponent;
begin
i:=GetHandlerCount(htBeforeAddComponent);
while GetNextHandlerIndex(htBeforeAddComponent,i) do begin
Handler:=TPropHookBeforeAddComponent(FHandlers[htBeforeAddComponent][i]);
Result:=Handler(Sender,AComponentClass,Parent);
if not Result then exit;
end;
Result:=true;
end;
procedure TPropertyEditorHook.ComponentRenamed(AComponent: TComponent);
var
i: Integer;
@ -4669,6 +4695,18 @@ begin
RemoveHandler(htGetRootClassName,TMethod(OnGetRootClassName));
end;
procedure TPropertyEditorHook.AddHandlerBeforeAddComponent(
OnBeforeAddComponent: TPropHookBeforeAddComponent);
begin
AddHandler(htBeforeAddComponent,TMethod(OnBeforeAddComponent));
end;
procedure TPropertyEditorHook.RemoveHandlerBeforeAddComponent(
OnBeforeAddComponent: TPropHookBeforeAddComponent);
begin
RemoveHandler(htBeforeAddComponent,TMethod(OnBeforeAddComponent));
end;
procedure TPropertyEditorHook.AddHandlerComponentRenamed(
OnComponentRenamed: TPropHookComponentRenamed);
begin

100
ide/customformeditor.pp
View File

@ -38,9 +38,10 @@ uses
{$IFDEF IDE_MEM_CHECK}
MemCheck,
{$ENDIF}
Classes, AbstractFormeditor, Controls, PropEdits, TypInfo, ObjectInspector,
Forms, Menus, Dialogs, AVL_Tree, JITForms, NonControlForms, ComponentReg,
IDEProcs, ComponentEditors, KeyMapping, EditorOptions, Designerprocs;
Classes, SysUtils, AbstractFormeditor, Controls, PropEdits, TypInfo,
Forms, Menus, Dialogs, AVL_Tree, ObjectInspector, JITForms, NonControlForms,
ComponentReg, IDEProcs, ComponentEditors, KeyMapping, EditorOptions,
Designerprocs;
Const OrdinalTypes = [tkInteger,tkChar,tkENumeration,tkbool];
@ -137,10 +138,21 @@ each control that's dropped onto the form
Procedure DeleteControl(AComponent: TComponent; FreeComponent: boolean);
Function FindComponentByName(const Name : ShortString) : TIComponentInterface; override;
Function FindComponent(AComponent: TComponent): TIComponentInterface; override;
function IsJITComponent(AComponent: TComponent): boolean;
function GetJITListOfType(AncestorType: TComponentClass): TJITComponentList;
function FindJITList(AComponent: TComponent): TJITComponentList;
function GetDesignerForm(AComponent: TComponent): TCustomForm;
function FindNonControlForm(LookupRoot: TComponent): TNonControlForm;
function CreateNonControlForm(LookupRoot: TComponent): TNonControlForm;
procedure RenameJITComponent(AComponent: TComponent;
const NewName: shortstring);
procedure UpdateDesignerFormName(AComponent: TComponent);
function CreateNewJITMethod(AComponent: TComponent;
const AMethodName: shortstring): TMethod;
procedure RenameJITMethod(AComponent: TComponent;
const OldMethodName, NewMethodName: shortstring);
procedure SaveHiddenDesignerFormProperties(AComponent: TComponent);
function GetComponentEditor(AComponent: TComponent): TBaseComponentEditor;
function CreateUniqueComponentName(AComponent: TComponent): string;
@ -173,7 +185,7 @@ implementation
uses
SysUtils, Math;
Math;
function CompareComponentInterfaces(Data1, Data2: Pointer): integer;
var
@ -786,6 +798,17 @@ begin
Result:=nil;
end;
function TCustomFormEditor.FindJITList(AComponent: TComponent
): TJITComponentList;
begin
if JITFormList.IndexOf(AComponent)>=0 then
Result:=JITFormList
else if JITDataModuleList.IndexOf(AComponent)>=0 then
Result:=JITDataModuleList
else
Result:=nil;
end;
function TCustomFormEditor.GetDesignerForm(AComponent: TComponent
): TCustomForm;
var
@ -793,6 +816,8 @@ var
begin
Result:=nil;
OwnerComponent:=AComponent.Owner;
if OwnerComponent=nil then
OwnerComponent:=AComponent;
if OwnerComponent is TCustomForm then
Result:=TCustomForm(OwnerComponent)
else
@ -811,6 +836,73 @@ begin
Result:=nil;
end;
function TCustomFormEditor.CreateNonControlForm(LookupRoot: TComponent
): TNonControlForm;
begin
if FindNonControlFormNode(LookupRoot)<>nil then
RaiseException('TCustomFormEditor.CreateNonControlForm exists already');
if LookupRoot is TDataModule then begin
Result:=TDataModuleForm.Create(nil);
Result.LookupRoot:=LookupRoot;
FNonControlForms.Add(Result);
end else
RaiseException('TCustomFormEditor.CreateNonControlForm Unknown type '
+LookupRoot.ClassName);
end;
procedure TCustomFormEditor.RenameJITComponent(AComponent: TComponent;
const NewName: shortstring);
var
JITComponentList: TJITComponentList;
begin
JITComponentList:=FindJITList(AComponent);
if JITComponentList=nil then
RaiseException('TCustomFormEditor.RenameJITComponent');
JITComponentList.RenameComponentClass(AComponent,NewName);
end;
procedure TCustomFormEditor.UpdateDesignerFormName(AComponent: TComponent);
var
ANonControlForm: TNonControlForm;
begin
ANonControlForm:=FindNonControlForm(AComponent);
writeln('TCustomFormEditor.UpdateDesignerFormName ',ANonControlForm<>nil,' ',AComponent.Name);
if ANonControlForm<>nil then
ANonControlForm.Caption:=AComponent.Name;
end;
function TCustomFormEditor.CreateNewJITMethod(AComponent: TComponent;
const AMethodName: shortstring): TMethod;
var
JITComponentList: TJITComponentList;
begin
JITComponentList:=FindJITList(AComponent);
if JITComponentList=nil then
RaiseException('TCustomFormEditor.CreateNewJITMethod');
Result:=JITComponentList.CreateNewMethod(AComponent,AMethodName);
end;
procedure TCustomFormEditor.RenameJITMethod(AComponent: TComponent;
const OldMethodName, NewMethodName: shortstring);
var
JITComponentList: TJITComponentList;
begin
JITComponentList:=FindJITList(AComponent);
if JITComponentList=nil then
RaiseException('TCustomFormEditor.RenameJITMethod');
JITComponentList.RenameMethod(AComponent,OldMethodName,NewMethodName);
end;
procedure TCustomFormEditor.SaveHiddenDesignerFormProperties(
AComponent: TComponent);
var
NonControlForm: TNonControlForm;
begin
NonControlForm:=FindNonControlForm(AComponent);
if NonControlForm<>nil then
NonControlForm.DoSaveBounds;
end;
function TCustomFormEditor.GetComponentEditor(AComponent: TComponent
): TBaseComponentEditor;
var

2
ide/newdialog.pas
View File

@ -550,10 +550,8 @@ begin
Add(NewCategory);
NewCategory.Add(TNewIDEItemTemplate.Create(niiUnit,'Unit',niifCopy,[]));
NewCategory.Add(TNewIDEItemTemplate.Create(niiForm,'Form',niifCopy,[]));
{$IFDEF EnableDataMods}
NewCategory.Add(TNewIDEItemTemplate.Create(niiDataModule,'Data Module',
niifCopy,[]));
{$ENDIF}
NewCategory.Add(TNewIDEItemTemplate.Create(niiText,'Text',niifCopy,[]));
// category project

5
ide/project.pp
View File

@ -447,7 +447,7 @@ type
property FirstRequiredDependency: TPkgDependency
read FFirstRequiredDependency;
property FirstUnitWithEditorIndex: TUnitInfo read GetFirstUnitWithEditorIndex;
property FirstUnitWithForm: TUnitInfo read GetFirstUnitWithComponent;
property FirstUnitWithComponent: TUnitInfo read GetFirstUnitWithComponent;
property Flags: TProjectFlags read FFlags write SetFlags;
property IconPath: String read fIconPath write fIconPath;
property JumpHistory: TProjectJumpHistory
@ -2638,6 +2638,9 @@ end.
{
$Log$
Revision 1.126 2003/06/01 21:09:09 mattias
implemented datamodules
Revision 1.125 2003/06/01 11:23:01 mattias
splittet designer form and lookup root

40
lcl/forms.pp
View File

@ -336,7 +336,7 @@ type
procedure UpdateShowing; override;
procedure UpdateWindowState;
procedure ValidateRename(AComponent: TComponent;
const CurName, NewName: string);override;
const CurName, NewName: string); override;
procedure VisibleChanging; override;
procedure WndProc(var TheMessage : TLMessage); override;
public
@ -790,7 +790,15 @@ type
function SaveFocusState: TFocusState;
procedure RestoreFocusState(FocusState: TFocusState);
type
TGetDesignerFormEvent =
function(AComponent: TComponent): TCustomForm of object;
var
OnGetDesignerForm: TGetDesignerFormEvent;
function GetParentForm(Control:TControl): TCustomForm;
function GetDesignerForm(AComponent: TComponent): TCustomForm;
function FindRootDesigner(AComponent: TComponent): TIDesigner;
function IsAccel(VK : Word; const Str : ShortString): Boolean;
@ -1000,24 +1008,24 @@ end;
function FindRootDesigner(AComponent: TComponent): TIDesigner;
var
Form: TCustomForm;
begin
Result:=nil;
Form:=GetDesignerForm(AComponent);
if Form<>nil then
Result:=Form.Designer;
end;
function GetDesignerForm(AComponent: TComponent): TCustomForm;
var
Owner: TComponent;
begin
Result:=nil;
if AComponent=nil then exit;
while (AComponent<>nil) do begin
if (AComponent is TCustomForm) then begin
Form:=TCustomForm(AComponent);
if Form.Parent=nil then begin
Result:=Form.Designer;
exit;
end;
end;
if AComponent is TControl then begin
AComponent:=TControl(AComponent).Parent;
end else if (AComponent.Owner<>nil) then begin
AComponent:=AComponent.Owner;
end else begin
exit;
end;
if Assigned(OnGetDesignerForm) then
Result:=OnGetDesignerForm(AComponent)
else begin
Owner:=AComponent.Owner;
if Owner is TCustomForm then Result:=TCustomForm(Owner);
end;
end;

17
lcl/include/customform.inc
View File

@ -625,18 +625,18 @@ Begin
inherited RequestAlign;
end;
{------------------------------------------------------------------------------}
{ TCustomForm SetDesigner }
{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------
TCustomForm SetDesigner
------------------------------------------------------------------------------}
Procedure TCustomForm.SetDesigner(Value : TIDesigner);
Begin
FDesigner := Value;
end;
{------------------------------------------------------------------------------}
{ TCustomForm ValidateRename }
{ if AComponent is nil, then the name of Self is changed }
{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------
TCustomForm ValidateRename
if AComponent is nil, then the name of Self is changed
------------------------------------------------------------------------------}
procedure TCustomForm.ValidateRename(AComponent: TComponent;
const CurName, NewName: String);
begin
@ -1426,6 +1426,9 @@ end;
{ =============================================================================
$Log$
Revision 1.100 2003/06/01 21:09:09 mattias
implemented datamodules
Revision 1.99 2003/05/24 08:51:41 mattias
implemented designer close query

55
lcl/lresources.pp
View File

@ -68,6 +68,7 @@ function LFMtoLRSfile(LFMfilename:ansistring):boolean;
function LFMtoLRSstream(LFMStream,LFCStream:TStream):boolean;
// returns true if successful
function FindLFMClassName(LFMStream:TStream):AnsiString;
function CreateLFMFile(AComponent: TComponent; LFMStream: TStream): integer;
type
TDelphiStreamOriginalFormat = (sofUnknown, sofBinary, sofText);
@ -177,14 +178,21 @@ begin
end;
function FindLFMClassName(LFMStream:TStream):ansistring;
// the classname is the last word of the first line
{ examples:
object Form1: TForm1
inherited AboutBox2: TAboutBox2
-> the classname is the last word of the first line
}
var c:char;
StartPos,EndPos:integer;
begin
Result:='';
StartPos:=-1;
c:=' ';
// read till end of line
repeat
// remember last non identifier char position
if (not (c in ['a'..'z','A'..'Z','0'..'9','_'])) then
StartPos:=LFMStream.Position;
LFMStream.Read(c,1);
@ -192,10 +200,13 @@ begin
until c in [#10,#13];
if StartPos<0 then exit;
EndPos:=LFMStream.Position-1;
if EndPos-StartPos>255 then exit;
SetLength(Result,EndPos-StartPos);
LFMStream.Position:=StartPos;
LFMStream.Read(Result[1],length(Result));
LFMStream.Position:=0;
if (Result='') or (not IsValidIdent(Result)) then
Result:='';
end;
function LFMtoLRSfile(LFMfilename:ansistring):boolean;
@ -832,6 +843,48 @@ begin
FStream.Write(Buf,Count);
end;
function CreateLFMFile(AComponent: TComponent; LFMStream: TStream): integer;
// 0 = ok
// -1 = error while streaming AForm to binary stream
// -2 = error while streaming binary stream to text file
var
BinStream: TMemoryStream;
Driver: TAbstractObjectWriter;
Writer: TWriter;
begin
Result:=0;
BinStream:=TMemoryStream.Create;
try
try
// write component to binary stream
Driver:=TBinaryObjectWriter.Create(BinStream,4096);
try
Writer:=TWriter.Create(Driver);
try
Writer.WriteDescendent(AComponent,nil);
finally
Writer.Free;
end;
finally
Driver.Free;
end;
except
Result:=-1;
exit;
end;
try
// transform binary to text
BinStream.Position:=0;
ObjectBinaryToText(BinStream,LFMStream);
except
Result:=-2;
exit;
end;
finally
BinStream.Free;
end;
end;
procedure DelphiObjectBinaryToText(Input, Output: TStream);
var
NestingLevel: Integer;

29
packager/componentreg.pas
View File

@ -38,7 +38,7 @@ unit ComponentReg;
interface
uses
Classes, SysUtils,
Classes, SysUtils, Controls,
{$IFDEF CustomIDEComps}
CustomIDEComps,
{$ENDIF}
@ -86,6 +86,7 @@ type
function GetPriority: TComponentPriority; virtual;
procedure AddToPalette; virtual;
function CanBeCreatedInDesigner: boolean; virtual;
procedure ShowHideControl(Show: boolean);
public
property ComponentClass: TComponentClass read FComponentClass;
property PageName: string read FPageName;
@ -121,6 +122,7 @@ type
procedure Remove(AComponent: TRegisteredComponent);
function FindComponent(const CompClassName: string): TRegisteredComponent;
function FindButton(Button: TComponent): TRegisteredComponent;
procedure ShowHideControls(Show: boolean);
public
property Items[Index: integer]: TRegisteredComponent read GetItems; default;
property PageName: string read FPageName;
@ -172,6 +174,7 @@ type
function FindButton(Button: TComponent): TRegisteredComponent;
function CreateNewClassName(const Prefix: string): string;
function IndexOfPageComponent(AComponent: TComponent): integer;
procedure ShowHideControls(Show: boolean);
public
property Pages[Index: integer]: TBaseComponentPage read GetItems; default;
property UpdateLock: integer read FUpdateLock;
@ -268,6 +271,12 @@ begin
Result:=true;
end;
procedure TRegisteredComponent.ShowHideControl(Show: boolean);
begin
if ComponentClass.InheritsFrom(TControl) then
Visible:=Show;
end;
{ TBaseComponentPage }
function TBaseComponentPage.GetItems(Index: integer): TRegisteredComponent;
@ -379,6 +388,14 @@ begin
Result:=nil;
end;
procedure TBaseComponentPage.ShowHideControls(Show: boolean);
var
i: Integer;
begin
for i:=0 to Count-1 do
Items[i].ShowHideControl(Show);
end;
{ TBaseComponentPalette }
function TBaseComponentPalette.GetItems(Index: integer): TBaseComponentPage;
@ -577,6 +594,16 @@ begin
Result:=-1;
end;
procedure TBaseComponentPalette.ShowHideControls(Show: boolean);
var
i: Integer;
begin
BeginUpdate(false);
for i:=0 to Count-1 do
Pages[i].ShowHideControls(Show);
EndUpdate;
end;
initialization
IDEComponentPalette:=nil;