paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-11-26 09:47:16 +01:00
Code Issues Packages Projects Releases Wiki Activity

Changed TDesigner. It's now notified when a control is added to it's CustomForm.

Browse Source 
It's created in main.pp when New Form is selected.

Shane

git-svn-id: trunk@53 -
This commit is contained in:
lazarus 2000-11-30 21:43:38 +00:00
parent fe6058b7fc
commit 8ad22a1c8f
10 changed files with 227 additions and 347 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -200,7 +200,6 @@ lcl/include/custommemo.inc svneol=native#text/pascal
lcl/include/customnotebook.inc svneol=native#text/pascal lcl/include/customnotebook.inc svneol=native#text/pascal
lcl/include/customradiogroup.inc svneol=native#text/pascal lcl/include/customradiogroup.inc svneol=native#text/pascal
lcl/include/defaultbitbtnimages.inc svneol=native#text/pascal lcl/include/defaultbitbtnimages.inc svneol=native#text/pascal
lcl/include/designer.inc svneol=native#text/pascal
lcl/include/dragobject.inc svneol=native#text/pascal lcl/include/dragobject.inc svneol=native#text/pascal
lcl/include/edit.inc svneol=native#text/pascal lcl/include/edit.inc svneol=native#text/pascal
lcl/include/filectrl.inc svneol=native#text/pascal lcl/include/filectrl.inc svneol=native#text/pascal

15
designer/abstractformeditor.pp
View File

@ -66,6 +66,21 @@ or use TPropertyType
end; end;
TIFormInterface = class
public
Function Filename : String; virtual; abstract;
Function FormModified : Boolean; virtual; abstract;
Function MArkModified : Boolean; virtual; abstract;
Function GetFormComponent : TIComponentInterface; virtual; abstract;
Function FindComponent : TIComponentInterface; virtual; abstract;
Function GetComponentfromHandle(ComponentHandle:Pointer): TIComponentInterface; virtual; abstract;
Function GetSelCount: Integer; virtual; abstract;
Function GetSelComponent(Index : Integer): TIComponentInterface; virtual; abstract;
Function CreateComponent(CI : TIComponentInterface; TypeClass : TComponentClass;
X,Y,W,H : Integer): TIComponentInterface; virtual; abstract;
end;
{ {
Created by Shane Miller Created by Shane Miller
This unit defines the layout for the forms editor. The forms editor is responsible This unit defines the layout for the forms editor. The forms editor is responsible

126
designer/designer.pp
View File

@ -25,30 +25,140 @@ unit designer;
interface interface
uses uses
classes; classes,Forms,controls,lmessages,graphics,ControlSelection;
type type
TDesigner = class(TObject) TGridPoint = record
x: integer;
y: integer;
end;
TDesigner = class(TIDesigner)
private
FCustomForm: TCustomForm;
FControlSelection : TControlSelection;
function GetIsControl: Boolean;
procedure SetIsControl(Value: Boolean);
protected
ControlSelection : TControlSelection;
public public
constructor Create;override; constructor Create(customform : TCustomform);
destructor Destroy; override;
procedure CreateNew(FileName : string); procedure CreateNew(FileName : string);
procedure LoadFile(FileName: string); procedure LoadFile(FileName: string);
function IsDesignMsg(Sender: TControl; var Message: TLMessage): Boolean; override;
procedure Modified; override;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure PaintGrid; override;
procedure ValidateRename(AComponent: TComponent; const CurName, NewName: string); override;
property IsControl: Boolean read GetIsControl write SetIsControl;
property Form: TCustomForm read FCustomForm write FCustomForm;
end; end;
implementation implementation
constructor Create;override; var
GridPoints : TGridPoint;
constructor TDesigner.Create(CustomForm : TCustomForm);
begin
inherited Create;
FCustomForm := CustomForm;
ControlSelection := TControlSelection.Create(FCustomForm);
end;
destructor TDesigner.Destroy;
Begin
Inherited;
ControlSelection.free;
end;
procedure TDesigner.CreateNew(FileName : string);
begin
end;
procedure TDesigner.LoadFile(FileName: string);
begin
end;
function TDesigner.IsDesignMsg(Sender: TControl; var Message: TLMessage): Boolean;
Begin
end;
procedure TDesigner.Modified;
Begin
end;
procedure TDesigner.Notification(AComponent: TComponent; Operation: TOperation);
Begin
if Operation = opInsert then
begin begin
//AComponent.SetDesigning(True);
if (AComponent is TCOntrol) then
Begin
// TControl(AComponent).Visible := True;
ControlSelection.Clear;
Controlselection.Add(TCOntrol(AComponent));
end;
end
else
if Operation = opRemove then
begin
if (AComponent is TControl) then
if ControlSelection.IsSelected(TControl(AComponent)) then
ControlSelection.Remove(TControl(AComponent));
end; end;
procedure CreateNew(FileName : string); end;
begin
end;
procedure LoadFile(FileName: string); procedure TDesigner.PaintGrid;
var
x,y : integer;
begin
with FCustomForm do
Begin
canvas.Pen.Color := clGray;
X := left;
while X <= left + width do
begin begin
Y := Top;
while y <= top+height do
begin
Canvas.Rectangle(x-left,y-top,x-left+1,y-top);
Inc(Y, GridPoints.Y);
end; end;
Inc(x, GridPoints.X);
end;
end;
end;
procedure TDesigner.ValidateRename(AComponent: TComponent; const CurName, NewName: string);
Begin
end;
function TDesigner.GetIsControl: Boolean;
Begin
end;
procedure TDesigner.SetIsControl(Value: Boolean);
Begin
end;
initialization
Gridpoints.x := 10;
GridPoints.Y := 10;
end. end.

16
ide/customformeditor.pp
View File

@ -159,13 +159,16 @@ PP : PPropList;
PI : PTypeInfo; PI : PTypeInfo;
I : Longint; I : Longint;
Begin Begin
PT:=GetTypeData(FControl.ClassInfo); Name := Uppercase(name);
PI := FControl.ClassInfo;
PT:=GetTypeData(PI);
if PT <> nil then Writeln('PT is NOT nil') else Writeln('PT is NIL');
GetMem (PP,PT^.PropCount*SizeOf(Pointer)); GetMem (PP,PT^.PropCount*SizeOf(Pointer));
GetPropInfos(PI,PP); GetPropInfos(PI,PP);
I := -1; I := -1;
repeat repeat
inc(i); inc(i);
until (PP^[i]^.Name = Name) or (i > PT^.PropCount-1); until (PP^[i]^.Name = Name) or (i = PT^.PropCount-1);
if PP^[i]^.Name = Name then if PP^[i]^.Name = Name then
Result:=PP^[i] Result:=PP^[i]
@ -377,19 +380,26 @@ Function TComponentInterface.SetPropbyName(Name : String; const Value) : Boolean
var var
PRI : PPropInfo; PRI : PPropInfo;
Begin Begin
Writeln('*************');
Writeln('SetPropByName');
Result := False; Result := False;
PRI := GetPPropInfoByName(Name); PRI := GetPPropInfoByName(Uppercase(Name));
Writeln('Back from GetPPropInfobyName');
if PRI <> nil then if PRI <> nil then
with PRI^ do with PRI^ do
Begin Begin
if SetProc <> nil then if SetProc <> nil then
Begin //call the procedure passing Value Begin //call the procedure passing Value
Writeln('Assigning the procedure');
MySetProc := TSetProc(SetProc^); MySetProc := TSetProc(SetProc^);
Writeln('Calling the procedure');
MySetProc(Value); MySetProc(Value);
Result := True; Result := True;
end; end;
end; end;
Writeln('SetPropByName Exiting...');
Writeln('*************');
end; end;

302
ide/main.pp
View File

@ -31,7 +31,7 @@ uses
classes,LclLinux,compiler, stdctrls,forms,buttons,menus,comctrls, classes,LclLinux,compiler, stdctrls,forms,buttons,menus,comctrls,
Spin, project,sysutils, global, Spin, project,sysutils, global,
compileroptions,Controls,graphics,extctrls, Dialogs,dlgMEssage, compileroptions,Controls,graphics,extctrls, Dialogs,dlgMEssage,
designerform,process,idecomp,Find_dlg,FormEditor,CustomFormEditor,Object_Inspector; Designer,process,idecomp,Find_dlg,FormEditor,CustomFormEditor,Object_Inspector;
const const
STANDARDBTNCOUNT = 50; STANDARDBTNCOUNT = 50;
@ -145,11 +145,9 @@ type
procedure ControlClick(Sender : TObject); procedure ControlClick(Sender : TObject);
procedure MessageViewDblClick(Sender : TObject); procedure MessageViewDblClick(Sender : TObject);
procedure DesignFormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
private private
Function CreateSeperator : TMenuItem; Function CreateSeperator : TMenuItem;
Procedure SetBtnDefaults(Control : Pointer;I,Page : Integer); Procedure SetBtnDefaults(Control : Pointer;I,Page : Integer);
function CreateNewForm : TDesignerForm;
Function ReturnActiveUnitList : TUnitInfo; Function ReturnActiveUnitList : TUnitInfo;
Function Create_LFM(SList : TUnitInfo) : Boolean; Function Create_LFM(SList : TUnitInfo) : Boolean;
Function SavebyUnit(SList : TUnitInfo) : Boolean; Function SavebyUnit(SList : TUnitInfo) : Boolean;
@ -194,6 +192,7 @@ var
Form1 : TForm1; Form1 : TForm1;
FormEditor1 : TFormEditor; FormEditor1 : TFormEditor;
ObjectInspector1 : TObjectInspector; ObjectInspector1 : TObjectInspector;
Taginc : Integer; Taginc : Integer;
implementation implementation
uses uses
@ -1330,81 +1329,6 @@ For I := 0 to Project1.UnitList.Count-1 do
End; End;
procedure TForm1.DesignFormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
NewObj : TControl;
i: Integer;
begin
if (Button = mbLeft)
then begin
// OK for the sake of showing something I'll use this
// WE NEED SOMETHING ELSE
NewObj := TIdeComponent(ideComplist.items[bpressed-1]).CreateMethod(TDesignerForm(Sender));
if NewObj <> nil
then begin
TDesignerForm(Sender).AddControl(NewObj, X, Y);
//this resets it to the mouse.
ControlClick(Notebook1);
//add line into source for the control.
for i := 0 to Project1.Unitlist.Count-1 do
begin
if TUnitInfo(Project1.Unitlist.items[i]).Formname = TForm(sender).name
then Break;
end;
if I < Project1.Unitlist.Count
then begin
TUnitInfo(Project1.Unitlist.items[i]).AddControlLine(NewObj.name + ': ' + NewObj.ClassName);
end;
end;
end;
end;
(*
{
------------------------------------------------------------------------
------------------------------------------------------------------------
-------------------ClickOnForm-----------------------------------------
------------------------------------------------------------------------
------------------------------------------------------------------------
}
procedure TForm1.ClickonForm(Sender : TObject);
var
MOusePos : TPoint;
NewObj : TControl;
I : Integer;
Begin
NewObj := TideComponent(ideComplist.items[bpressed-1]).CreateMethod(TDesignerForm(Sender));
if (newobj <> nil) then
begin
if (NewOBj is TWinControl) then
TDesignerForm(Sender).AddDesignerWinControl(NewObj)
else
TDesignerForm(Sender).AddDesignerControl(NewObj);
ControlClick(Notebook1); //this resets it to the mouse.
//add line into source for the control.
for i := 0 to Project1.Unitlist.Count-1 do
begin
if TUnitInfo(Project1.Unitlist.items[i]).Formname = TForm(sender).name then break;
end;
if I < Project1.Unitlist.Count then
Begin
TUnitInfo(Project1.Unitlist.items[i]).AddControlLine(NewObj.name+': '+NewObj.ClassName);
end;
end;
end;
*)
{ {
@ -1541,6 +1465,7 @@ Begin
//otherwise we drop a control and call the CreateComponent function. //otherwise we drop a control and call the CreateComponent function.
if BPressed = 1 then if BPressed = 1 then
Begin //mouse button pressed. Begin //mouse button pressed.
FormEditor1.ClearSelected; FormEditor1.ClearSelected;
Writeln('Clicked on the control!!!!! Control name is '+TControl(sender).name); Writeln('Clicked on the control!!!!! Control name is '+TControl(sender).name);
FormEditor1.AddSelected(TComponent(Sender)); FormEditor1.AddSelected(TComponent(Sender));
@ -1549,7 +1474,7 @@ if BPressed = 1 then
Begin //add a new control Begin //add a new control
CInterface := TComponentInterface(FormEditor1.CreateComponent(nil, CInterface := TComponentInterface(FormEditor1.CreateComponent(nil,
TComponentClass(TIdeComponent(ideComplist.items[bpressed-1]).ClassType),-1,-1,-1,-1)); TComponentClass(TIdeComponent(ideComplist.items[bpressed-1]).ClassType),-1,-1,-1,-1));
TControl(CInterface.Control).Visible := True; CInterface.Setpropbyname('Visible',True);//Control).Visible := True;
//set the ONCLICK event so we know when the control is selected; //set the ONCLICK event so we know when the control is selected;
TControl(CInterface.Control).OnClick := @ClickOnControl; TControl(CInterface.Control).OnClick := @ClickOnControl;
@ -1642,15 +1567,15 @@ if (X >= 0) and (X <= TControl(sender).Width) and
else else
CInterface := TComponentInterface(FormEditor1.CreateComponent(nil, CInterface := TComponentInterface(FormEditor1.CreateComponent(nil,
TComponentClass(TIdeComponent(ideComplist.items[bpressed-1]).ClassType),Mouse_Down.X,Mouse_Down.Y,-1,-1)); TComponentClass(TIdeComponent(ideComplist.items[bpressed-1]).ClassType),Mouse_Down.X,Mouse_Down.Y,-1,-1));
// CInterface.Setpropbyname('Visible',True);//Control).Visible := True;
TControl(CInterface.Control).Visible := True;
//set the ONCLICK event so we know when the control is selected; //set the ONCLICK event so we know when the control is selected;
TControl(CInterface.Control).Visible := True;
TControl(CInterface.Control).OnClick := @ClickOnControl; TControl(CInterface.Control).OnClick := @ClickOnControl;
FormEditor1.ClearSelected; FormEditor1.ClearSelected;
FormEditor1.AddSelected(TComponent(Cinterface.Control)); FormEditor1.AddSelected(TComponent(Cinterface.Control));
ObjectInspector1.RootComponent := TForm(sender); ObjectInspector1.RootComponent := TForm(sender);
ObjectInspector1.FillComponentComboBox;
end; end;
//TIdeComponent(ideComplist.items[bpressed-1]). //TIdeComponent(ideComplist.items[bpressed-1]).
@ -1680,8 +1605,10 @@ begin
if not Assigned(FormEditor1) then if not Assigned(FormEditor1) then
FormEditor1 := TFormEditor.Create; FormEditor1 := TFormEditor.Create;
FormEditor1.SelectedComponents.Clear; FormEditor1.SelectedComponents.Clear;
CInterface := TComponentInterface(FormEditor1.CreateComponent(nil,TForm,50,50,300,400)); CInterface := TComponentInterface(FormEditor1.CreateComponent(nil,TForm,50,50,300,400));
TForm(CInterface.Control).Name := 'Form1'; TForm(CInterface.Control).Name := 'Form1';
TForm(CInterface.Control).Designer := TDesigner.Create(TCustomForm(CInterface.Control));
TForm(CInterface.Control).Show; TForm(CInterface.Control).Show;
//set the ONCLICK event so we know when a control is dropped onto the form. //set the ONCLICK event so we know when a control is dropped onto the form.
@ -1692,46 +1619,6 @@ begin
end; end;
function TForm1.CreateNewForm : TDesignerForm;
var
NewName : String;
I : Integer;
Num : Integer;
Found : Boolean;
Form : TDesignerForm;
Begin
NewName := 'TForm';
delete(Newname,1,1);
Found := false;
Num := 1;
while not found do
Begin
Found := true;
if ControlCount > 0 then
for i := 0 to ControlCount-1 do
begin
if Controls[i].name = (Newname+inttostr(Num)) then
Begin
inc(num);
Found := False;
break;
end;
end;
end; //while
Form := TDesignerForm.Create(self);
Form.parent := Self;
Form.Name := NewName+inttostr(num);
Form.Position:= poDesigned;
Form.OnMouseUp := @DesignFormMouseUp;
Form.Show;
Form.Caption := Form.name;
Form.Top := Top+Height;
Form.Left := 150;
//Create lfm file
result := Form;
end;
{------------------------------------------------------------------------------} {------------------------------------------------------------------------------}
procedure TForm1.mnuOpenClicked(Sender : TObject); procedure TForm1.mnuOpenClicked(Sender : TObject);
@ -2072,189 +1959,24 @@ var
SList : TUnitInfo; SList : TUnitInfo;
Begin Begin
Assert(False, 'Trace:New Project Clicked'); Assert(False, 'Trace:New Project Clicked');
if Project1.UnitList.Count > 0 then
Begin //project already loaded
//save other project and such
Project1.UnitList.Clear;
end;
Assert(False, 'Trace:*************************************************************************');
Project1.Name := 'Project1';
Caption := 'Lazarus - '+Project1.Name;
SList := TUnitInfo.Create;
SList.Name := 'Project1.lpr';
SList.FormName := '';
SList.Flags := pfPRoject;
with SList.Source do
Begin
//Add the default lines
Add('Program Project1;');
Add('');
Add('uses');
Add(' Forms,');
// Add(' Unit1 in ''Unit1.pp'' {Form1};');
Add(' Unit1;');
Add('');
Add('begin');
Add(' Application.Initialize;');
Add(' Application.CreateForm(TForm1, Form1);');
Add(' Application.Run;');
Add('end.');
end;
SList.Filename := '';
SList.Page := -1;
Project1.AddUnit(SList);
Assert(False, 'Trace:Project1.UnitList.count = '+inttostr(Project1.UnitList.Count));
//Create first unit, then display it.
SList := TUnitInfo.Create;
SList.Name := 'Unit1.pp';
SList.Form := CreateNewForm;
SList.Formname := SList.Form.Name;
SList.Flags := pfForm;
with SList.Source do
Begin
//Add the default lines
Add('unit Unit1;');
Add('');
Add('{$mode objfpc}');
Add('');
Add('interface');
Add('');
Add('uses');
Add('Classes, Messages, SysUtils, Graphics, Controls, Forms, Dialogs;');
Add('');
Add('type');
Add(' T'+SList.Formname+' = class(TForm)');
Add(' private');
Add(' { Private declarations }');
Add(' public');
Add(' { Public declarations }');
Add(' end;');
Add('');
Add('var');
Add(' '+SList.FormName+': TForm1;');
Add('');
Add('implementation');
Add('');
Add('end.');
end;
SList.Filename := '';
//display unit1
//fill ViewUnits Listbox
ideEditor1.AddPage(SList.Name,SList.Source);
SList.Page := ideEditor1.Notebook1.Pageindex;
Project1.AddUnit(SList);
UpdateViewDialogs;
Assert(False, 'Trace:*************************************************************************');
ideEditor1.Show;
end; end;
{------------------------------------------------------------} {------------------------------------------------------------}
Procedure TForm1.mnuOpenProjectClicked(Sender : TObject); Procedure TForm1.mnuOpenProjectClicked(Sender : TObject);
Var
I : Integer;
pName : String;
Begin Begin
OpenDialog1.Filter := '*.lpr';
OpenDialog1.Title := 'Open Project file:';
If OpenDialog1.Execute then
Begin
if Project1.UnitList.Count > 0 then
Begin //project already loaded
//save other project and such
Project1.UnitList.Clear;
//Clear all notebook pages
for I := 0 to ideEditor1.Notebook1.Pages.count-1 do
IdeEditor1.DeletePage(0);
end;
PName := ExtractFilePath(OpenDialog1.Filename)+Copy(ExtractFileName(OpenDialog1.Filename),1,pos('.',ExtractFileName(OpenDialog1.Filename))-1);
if Project1.OpenProject(PName) then
Begin
Project1.Name := Copy(ExtractFileName(OpenDialog1.Filename),1,pos('.',OpenDialog1.Filename)-1);
Caption := 'Lazarus - '+Project1.Name;
UpdateViewDialogs;
end;
End;
end; end;
Procedure TForm1.mnuSaveProjectClicked(Sender : TObject); Procedure TForm1.mnuSaveProjectClicked(Sender : TObject);
Var
I : Integer;
PName : String;
Begin Begin
if Project1.UnitList.Count <= 0 then exit;
SaveDialog1.Filter := '*.lpr';
SaveDialog1.Filename := '*.lpr';
SaveDialog1.Title := 'Save project as:';
//Determine if the Savedialog is needed to save the project file
for I := 0 to Project1.UnitList.Count-1 do
Begin
//Save each unit
if (TUnitInfo(Project1.UnitList.Items[I]).Flags = pfProject) and
(TUnitInfo(Project1.UnitList.Items[I]).filename = '') then
Begin
if SaveDialog1.Execute then
Begin
TUnitInfo(Project1.UnitList.Items[I]).FileName := SaveDialog1.Filename;
TUnitInfo(Project1.UnitList.Items[i]).Name := Copy(ExtractFileName(SaveDialog1.Filename),1,pos('.',ExtractFileName(SaveDialog1.Filename))-1);
PName := ExtractFilePath(SaveDialog1.Filename)+Copy(ExtractFileName(SaveDialog1.Filename),1,pos('.',ExtractFileName(SaveDialog1.Filename))-1);
SaveDialog1.Filename := ExtractFilePath(Savedialog1.Filename)+TUnitInfo(Project1.UnitList.Items[i]).Name;
Project1.Name := SaveDialog1.Filename;
end
else
Exit;
break;
end
else
if (TUnitInfo(Project1.UnitList.Items[I]).Flags = pfProject) and
(TUnitInfo(Project1.UnitList.Items[I]).filename <> '') then
pName := ExtractFilePath(TUnitInfo(Project1.UnitList.Items[I]).filename)+Copy(ExtractFileName(TUnitInfo(Project1.UnitList.Items[I]).filename),1,pos('.',ExtractFileName(TUnitInfo(Project1.UnitList.Items[I]).filename))-1);
end;
for I := 0 to Project1.UnitList.Count-1 do
Begin
//Save each unit
if not(SavebyUnit(TUnitInfo(Project1.Unitlist.Items[I]))) then exit;
end;
Assert(False, 'Trace:PNAME = '+pname);
Project1.SaveProject(pname);
UpdateViewDialogs;
end; end;
Procedure TForm1.mnuBuildProjectClicked(Sender : TObject); Procedure TForm1.mnuBuildProjectClicked(Sender : TObject);
Const
BufSize = 1024;
Var
TheProgram : String;
Buf : Array[1..BUFSIZE] of char;
I,Count : longint;
Texts : String;
NUm : Integer;
WriteMessage : Boolean;
Begin Begin
if not(messagedlg.visible) then
MessageDlg.Show;
Messagedlg.Clear;
if Project1.UnitList.Count = 0 then Exit; //no project loaded
mnuSaveProjectClicked(self);
if TUnitInfo(Project1.UnitList[0]).FileName = '' then Exit;
MEssageDlg.Caption := 'Compiler Messages - Compiling.............';
Application.ProcessMessages;
Compiler1.Compile;
MessageDlg.Caption := 'Compiler Messages';
end; end;
@ -2471,8 +2193,10 @@ end.
{ ============================================================================= { =============================================================================
$Log$ $Log$
Revision 1.12 2000/11/29 21:22:35 lazarus Revision 1.13 2000/11/30 21:43:38 lazarus
New Object Inspector code Changed TDesigner. It's now notified when a control is added to it's CustomForm.
It's created in main.pp when New Form is selected.
Shane Shane
Revision 1.5 2000/08/10 13:22:51 lazarus Revision 1.5 2000/08/10 13:22:51 lazarus

6
lcl/controls.pp
View File

@ -1123,8 +1123,10 @@ end.
{ ============================================================================= { =============================================================================
$Log$ $Log$
Revision 1.4 2000/11/29 21:22:35 lazarus Revision 1.5 2000/11/30 21:43:38 lazarus
New Object Inspector code Changed TDesigner. It's now notified when a control is added to it's CustomForm.
It's created in main.pp when New Form is selected.
Shane Shane
Revision 1.3 2000/11/27 18:52:37 lazarus Revision 1.3 2000/11/27 18:52:37 lazarus

26
lcl/forms.pp
View File

@ -57,7 +57,7 @@ type
FAutoScroll : Boolean; FAutoScroll : Boolean;
end; end;
TDesigner = class; TIDesigner = class;
TCloseEvent = procedure(Sender: TObject; var Action: TCloseAction) of object; TCloseEvent = procedure(Sender: TObject; var Action: TCloseAction) of object;
@ -71,7 +71,7 @@ type
FActiveControl : TWinControl; FActiveControl : TWinControl;
FBorderStyle : TFormBorderStyle; FBorderStyle : TFormBorderStyle;
FCanvas : TControlCanvas; FCanvas : TControlCanvas;
FDesigner : TDesigner; FDesigner : TIDesigner;
FFormStyle : TFormStyle; FFormStyle : TFormStyle;
FKeyPreview: Boolean; FKeyPreview: Boolean;
FMenu : TMainMenu; FMenu : TMainMenu;
@ -90,7 +90,7 @@ type
procedure DoDestroy; procedure DoDestroy;
Procedure SetActiveControl(Value : TWinControl); Procedure SetActiveControl(Value : TWinControl);
Procedure SetBorderStyle(value : TFORMBorderStyle); Procedure SetBorderStyle(value : TFORMBorderStyle);
Procedure SetDesigner(Value : TDesigner); Procedure SetDesigner(Value : TIDesigner);
Procedure SetMenu(value : TMainMenu); Procedure SetMenu(value : TMainMenu);
Procedure SetFormStyle(Value : TFormStyle); Procedure SetFormStyle(Value : TFormStyle);
Procedure SetPosition(value : TPosition); Procedure SetPosition(value : TPosition);
@ -115,6 +115,7 @@ type
Function GetClientRect : TRect ; Override; Function GetClientRect : TRect ; Override;
Procedure Notification(AComponent: TComponent; Operation : TOperation);override; Procedure Notification(AComponent: TComponent; Operation : TOperation);override;
procedure Paint; dynamic; procedure Paint; dynamic;
Procedure PaintWindow(dc : Hdc); override;
Procedure RequestAlign; Override; Procedure RequestAlign; Override;
procedure UpdateShowing; override; procedure UpdateShowing; override;
procedure UpdateWindowState; procedure UpdateWindowState;
@ -146,7 +147,7 @@ type
property BorderStyle : TFormBorderStyle read FBorderStyle write SetBorderStyle default bsSizeable; property BorderStyle : TFormBorderStyle read FBorderStyle write SetBorderStyle default bsSizeable;
property Canvas: TControlCanvas read GetCanvas; property Canvas: TControlCanvas read GetCanvas;
property Caption stored IsForm; property Caption stored IsForm;
property Designer : TDesigner read FDesigner write SetDesigner; property Designer : TIDesigner read FDesigner write SetDesigner;
property FormState : TFormState read FFormState; property FormState : TFormState read FFormState;
property KeyPreview: Boolean read FKeyPreview write FKeyPreview; property KeyPreview: Boolean read FKeyPreview write FKeyPreview;
property Menu : TMainMenu read FMenu write SetMenu; property Menu : TMainMenu read FMenu write SetMenu;
@ -176,6 +177,11 @@ type
// property WindowState; // property WindowState;
property OnCreate; property OnCreate;
property OnDestroy; property OnDestroy;
property OnShow;
property OnHide;
property OnPaint;
property OnClose;
property OnCloseQuery;
end; end;
TFormClass = class of TForm; TFormClass = class of TForm;
@ -239,11 +245,7 @@ type
property OnIdle: TIdleEvent read FOnIdle write FOnIdle; property OnIdle: TIdleEvent read FOnIdle write FOnIdle;
end; end;
TDesigner = class(TObject) TIDesigner = class(TObject)
private
FCustomForm: TCustomForm;
function GetIsControl: Boolean;
procedure SetIsControl(Value: Boolean);
public public
function IsDesignMsg(Sender: TControl; var Message: TLMessage): Boolean; function IsDesignMsg(Sender: TControl; var Message: TLMessage): Boolean;
virtual; abstract; virtual; abstract;
@ -253,8 +255,6 @@ type
procedure PaintGrid; virtual; abstract; procedure PaintGrid; virtual; abstract;
procedure ValidateRename(AComponent: TComponent; procedure ValidateRename(AComponent: TComponent;
const CurName, NewName: string); virtual; abstract; const CurName, NewName: string); virtual; abstract;
property IsControl: Boolean read GetIsControl write SetIsControl;
property Form: TCustomForm read FCustomForm write FCustomForm;
end; end;
@ -279,7 +279,7 @@ implementation
uses uses
buttons,stdctrls,interfaces; buttons,stdctrls,interfaces,designer;
var var
FocusMessages : Boolean; //Should set it to TRUE by defualt but fpc does not handle that yet. FocusMessages : Boolean; //Should set it to TRUE by defualt but fpc does not handle that yet.
@ -321,7 +321,7 @@ end;
{$I Customform.inc} {$I Customform.inc}
{$I screen.inc} {$I screen.inc}
{$I application.inc} {$I application.inc}
{$I designer.inc}
initialization initialization
Screen:= TScreen.Create(nil); Screen:= TScreen.Create(nil);
Application:= TApplication.Create(nil); Application:= TApplication.Create(nil);

15
lcl/include/control.inc
View File

@ -379,9 +379,11 @@ begin
//Assert(False, Format('Trace:[TControl.WndPRoc] %s --> Message = %d',[CLASSNAME, Message.msg])); //Assert(False, Format('Trace:[TControl.WndPRoc] %s --> Message = %d',[CLASSNAME, Message.msg]));
//Assert(False, 'Trace:-----------IN TCONTROL WNDPROC----------'); //Assert(False, 'Trace:-----------IN TCONTROL WNDPROC----------');
if (csDesigning in ComponentState) if (csDesigning in ComponentState) then
then begin begin
Form := GetParentForm(Self);
if (Form <> nil) and (Form.Designer <> nil) and
Form.Designer.IsDesignMsg(Self,MEssage) then Exit;
end end
else else
begin begin
@ -712,6 +714,7 @@ procedure TControl.Notification( AComponent : TComponent; Operation : TOperation
begin begin
inherited Notification(AComponent, Operation); inherited Notification(AComponent, Operation);
if Operation = opRemove then if Operation = opRemove then
if AComponent = PopupMenu then PopupMenu := nil;
end; end;
@ -1239,6 +1242,12 @@ end;
{ ============================================================================= { =============================================================================
$Log$ $Log$
Revision 1.4 2000/11/30 21:43:38 lazarus
Changed TDesigner. It's now notified when a control is added to it's CustomForm.
It's created in main.pp when New Form is selected.
Shane
Revision 1.3 2000/11/29 21:22:35 lazarus Revision 1.3 2000/11/29 21:22:35 lazarus
New Object Inspector code New Object Inspector code
Shane Shane

32
lcl/include/customform.inc
View File

@ -261,6 +261,30 @@ begin
if Assigned (FOnPaint) and not(Isresizing) then FOnPaint(Self); if Assigned (FOnPaint) and not(Isresizing) then FOnPaint(Self);
end; end;
{------------------------------------------------------------------------------
Method: TCustomForm.PaintWindow
Params: none
Returns: nothing
Calls user handler
------------------------------------------------------------------------------}
Procedure TCustomForm.PaintWindow(DC : Hdc);
begin
// FCanvas.Lock;
try
FCanvas.Handle := DC;
try
if FDesigner <> nil then FDesigner.PaintGrid else Paint;
finally
FCanvas.Handle := 0;
end;
finally
// FCanvas.Unlock;
end;
end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
Method: TCustomForm.RequestAlign Method: TCustomForm.RequestAlign
@ -283,7 +307,7 @@ end;
{------------------------------------------------------------------------------} {------------------------------------------------------------------------------}
{ TCustomForm SetDesigner } { TCustomForm SetDesigner }
{------------------------------------------------------------------------------} {------------------------------------------------------------------------------}
Procedure TCustomForm.SetDesigner(Value : TDesigner); Procedure TCustomForm.SetDesigner(Value : TIDesigner);
Begin Begin
FDesigner := Value; FDesigner := Value;
end; end;
@ -782,6 +806,12 @@ end;
{ ============================================================================= { =============================================================================
$Log$ $Log$
Revision 1.6 2000/11/30 21:43:38 lazarus
Changed TDesigner. It's now notified when a control is added to it's CustomForm.
It's created in main.pp when New Form is selected.
Shane
Revision 1.5 2000/11/21 17:33:37 lazarus Revision 1.5 2000/11/21 17:33:37 lazarus
Added TCustomForm.Notification so the TDesigner is notified of actions. Added TCustomForm.Notification so the TDesigner is notified of actions.

19
lcl/include/designer.inc
View File

@ -1,19 +0,0 @@
{******************************************************************************
TDesigner
******************************************************************************}
{ TDesigner }
function TDesigner.GetIsControl: Boolean;
begin
// commented out because of a compiler error
// Result := (FCustomForm <> nil) and FCustomForm.IsControl;
Result := true;
end;
procedure TDesigner.SetIsControl(Value: Boolean);
begin
//commented out because of a compiler error
// if (FCustomForm <> nil) then FCustomForm.IsControl := Value;
end;