paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-29 13:10:53 +02:00
Code Issues Packages Projects Releases Wiki Activity

added popupmenu+arrows to notebooks, added target filename

Browse Source 
git-svn-id: trunk@389 -
This commit is contained in:
lazarus 2001-11-05 18:18:19 +00:00
parent 36964ad845
commit 4d2da430b7
10 changed files with 258 additions and 121 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
ide/compiler.pp
View File

@ -144,6 +144,7 @@ writeln('[TCompiler.Compile] Output="',OutputLine,'"');
end;
if (WriteMessage) and Assigned(OnOutputString) then
OnOutputString(OutputLine);
WriteMessage := false;
Application.ProcessMessages;
OutputLine:='';
@ -154,7 +155,7 @@ begin
Result:=mrCancel;
if AProject.MainUnit<0 then exit;
OldCurDir:=GetCurrentDir;
if AProject.Units[AProject.MainUnit].IsVirtual then
if Aproject.IsVirtual then
ProjectFilename:=DefaultFilename
else
ProjectFilename:=AProject.Units[AProject.MainUnit].Filename;
@ -165,6 +166,7 @@ begin
FOutputList.Clear;
SetLength(Buf,BufSize);
CmdLine := AProject.CompilerOptions.CompilerPath;
if Assigned(FOnCmdLineCreate) then begin
Abort:=false;
FOnCmdLineCreate(CmdLine,Abort);
@ -194,8 +196,9 @@ begin
exit;
end;
{$ENDIF linux}
CmdLine := CmdLine + ' '+ AProject.CompilerOptions.MakeOptionsString;
CmdLine := CmdLine + ' '+ ProjectFilename;
CmdLine := CmdLine
+ ' '+ AProject.CompilerOptions.MakeOptionsString(ProjectFilename)
+ ' '+ ProjectFilename;
if Assigned(FOnCmdLineCreate) then begin
Abort:=false;
FOnCmdLineCreate(CmdLine,Abort);
@ -325,6 +328,9 @@ end.
{
$Log$
Revision 1.16 2001/11/05 18:18:13 lazarus
added popupmenu+arrows to notebooks, added target filename
Revision 1.15 2001/10/23 09:13:50 lazarus
MG: fixed TestProject

48
ide/compileroptions.pp
View File

@ -31,8 +31,8 @@ unit compileroptions;
interface
uses
forms, classes, SysUtils, comctrls, buttons, stdctrls, extctrls, lazconf,
xmlcfg, filectrl;
Forms, Classes, SysUtils, ComCtrls, Buttons, StdCtrls, ExtCtrls, LazConf,
XMLCfg, FileCtrl;
type
{ Compiler Options object used to hold the compiler options }
@ -42,6 +42,7 @@ type
xmlcfg: TXMLConfig;
fProjectFile: String;
fTargetFilename: string;
fLoaded: Boolean;
fStyle: Integer;
@ -111,11 +112,14 @@ type
procedure LoadCompilerOptions(UseExistingFile: Boolean);
procedure SaveCompilerOptions(UseExistingFile: Boolean);
function MakeOptionsString: String;
function MakeOptionsString(const MainSourceFileName: string): String;
function ParseSearchPaths(const switch, paths: String): String;
function GetXMLConfigPath: String;
procedure Clear;
function CreateTargetFilename(const MainSourceFileName: string): string;
property ProjectFile: String read fProjectFile write fProjectFile;
property TargetFilename: String read fTargetFilename write fTargetFilename;
property XMLConfigFile: TXMLConfig read xmlcfg write xmlcfg;
property Loaded: Boolean read fLoaded write fLoaded;
@ -375,6 +379,9 @@ procedure TCompilerOptions.LoadTheCompilerOptions;
begin
{ Load the compiler options from the XML file }
{ Target }
TargetFilename := XMLConfigFile.GetValue('CompilerOptions/Target/Filename/Value', '');
{ Parsing }
Style := XMLConfigFile.GetValue('CompilerOptions/Parsing/Style/Value', 1);
@ -467,6 +474,10 @@ end;
procedure TCompilerOptions.SaveTheCompilerOptions;
begin
{ Save the compiler options to the XML file }
{ Target }
XMLConfigFile.GetValue('CompilerOptions/Target/Filename/Value', TargetFilename);
{ Parsing }
XMLConfigFile.SetValue('CompilerOptions/Parsing/Style/Value', Style);
XMLConfigFile.SetValue('CompilerOptions/Parsing/SymantecChecking/D2Extensions/Value', D2Extensions);
@ -533,10 +544,40 @@ begin
end;
{------------------------------------------------------------------------------}
{ TCompilerOptions CreateTargetFilename }
{------------------------------------------------------------------------------}
function TCompilerOptions.CreateTargetFilename(
const MainSourceFileName: string): string;
var Ext: string;
begin
if (TargetFilename <> '') then begin
Result:=ExtractFilePath(MainSourceFileName)+TargetFilename;
end else begin
if MainSourceFileName<>'' then begin
Result:=ExtractFileName(MainSourceFileName);
Ext:=ExtractFileExt(Result);
Result:=copy(Result,1,length(Result)-length(Ext));
Result:=lowercase(Result);
{$IFDEF win32}
Result:=Result+'.exe';
{$ENDIF}
Result:=ExtractFilePath(MainSourceFileName)+Result;
end else
Result:='';
end;
end;
{------------------------------------------------------------------------------}
{ TCompilerOptions MakeOptionsString }
{------------------------------------------------------------------------------}
function TCompilerOptions.MakeOptionsString: String;
begin
Result:=MakeOptionsString('')
end;
function TCompilerOptions.MakeOptionsString(
const MainSourceFilename: string): String;
var
switches, tempsw: String;
begin
@ -808,7 +849,6 @@ begin
-oprogramname = executable filename
-pg = generate profiler code
-a = Delete generated assembler files
-al = Include source code lines in assembler files as comments
@ -842,6 +882,8 @@ begin
-Xc = Link with C library (LINUX only)
}
if (TargetFilename <> '') or (MainSourceFilename<>'') then
switches := switches + ' -o' + CreateTargetFilename(MainSourceFilename);
{ Setting this to a default for now to allow the compiler to compile, until I get
the above completed. }

199
ide/main.pp
View File

@ -79,6 +79,7 @@ type
mnuSearch: TMenuItem;
mnuView: TMenuItem;
mnuProject: TMenuItem;
mnuRun: TMenuItem;
mnuEnvironment:TMenuItem;
itmSeperator: TMenuItem;
@ -101,6 +102,8 @@ type
itmProjectAddTo: TMenuItem;
itmProjectRemoveFrom: TMenuItem;
itmProjectViewSource: TMenuItem;
itmProjectOptions: TMenuItem;
itmProjectBuild: TMenuItem;
itmProjectRun: TMenuItem;
itmProjectPause: TMenuItem;
@ -108,7 +111,6 @@ type
itmProjectStepOver: TMenuItem;
itmProjectRunToCursor: TMenuItem;
itmProjectStop: TMenuItem;
itmProjectOptions: TMenuItem;
itmProjectCompilerSettings: TMenuItem;
itmEditUndo: TMenuItem;
@ -621,6 +623,8 @@ writeln('[TMainIDE.Destroy] A');
{$IFDEF IDE_MEM_CHECK}
CheckHeap(IntToStr(GetMem_Cnt));
{$ENDIF}
TheDebugger.Free;
TheDebugger:=nil;
if Project<>nil then begin
Project.Free;
Project:=nil;
@ -852,6 +856,11 @@ begin
mnuProject.Caption := '&Project';
mnuMain.Items.Add(mnuProject);
mnuRun := TMenuItem.Create(Self);
mnuRun.Name:='mnuRun';
mnuRun.Caption := '&Run';
mnuMain.Items.Add(mnuRun);
mnuEnvironment := TMenuItem.Create(Self);
mnuEnvironment.Name:='mnuEnvironment';
mnuEnvironment.Caption := 'E&nvironment';
@ -1090,63 +1099,67 @@ begin
mnuProject.Add(CreateSeperator);
itmProjectBuild := TMenuItem.Create(Self);
itmProjectBuild.Name:='itmProjectBuild';
itmProjectBuild.Caption := 'Build';
itmProjectBuild.OnClick := @mnuBuildProjectClicked;
mnuProject.Add(itmProjectBuild);
itmProjectRun := TMenuItem.Create(Self);
itmProjectRun.Name:='itmProjectRun';
itmProjectRun.Caption := 'Run';
itmProjectRun.OnClick := @mnuRunProjectClicked;
mnuProject.Add(itmProjectRun);
itmProjectPause := TMenuItem.Create(Self);
itmProjectPause.Name:='itmProjectPause';
itmProjectPause.Caption := 'Pause';
itmProjectPause.OnClick := @mnuPauseProjectClicked;
itmProjectPause.Enabled := false;
mnuProject.Add(itmProjectPause);
itmProjectStepInto := TMenuItem.Create(Self);
itmProjectStepInto.Name:='itmProjectStepInto';
itmProjectStepInto.Caption := 'Step into';
itmProjectStepInto.OnClick := @mnuStepIntoProjectClicked;
mnuProject.Add(itmProjectStepInto);
itmProjectStepOver := TMenuItem.Create(Self);
itmProjectStepOver.Name:='itmProjectStepOver';
itmProjectStepOver.Caption := 'Step over';
itmProjectStepOver.OnClick := @mnuStepOverProjectClicked;
mnuProject.Add(itmProjectStepOver);
itmProjectRunToCursor := TMenuItem.Create(Self);
itmProjectRunToCursor.Name:='itmProjectRunToCursor';
itmProjectRunToCursor.Caption := 'Run to cursor';
itmProjectRunToCursor.OnClick := @mnuRunToCursorProjectClicked;
mnuProject.Add(itmProjectRunToCursor);
itmProjectStop := TMenuItem.Create(Self);
itmProjectStop.Name:='itmProjectStop';
itmProjectStop.Caption := 'Stop';
itmProjectStop.OnClick := @mnuStopProjectClicked;
mnuProject.Add(itmProjectStop);
mnuProject.Add(CreateSeperator);
itmProjectCompilerSettings := TMenuItem.Create(Self);
itmProjectCompilerSettings.Name:='itmProjectCompilerSettings';
itmProjectCompilerSettings.Caption := 'Compiler Options...';
itmProjectCompilerSettings.OnClick := @mnuProjectCompilerSettingsClicked;
mnuProject.Add(itmProjectCompilerSettings);
itmProjectOptions := TMenuItem.Create(Self);
itmProjectOptions.Name:='itmProjectOptions';
itmProjectOptions.Caption := 'Project Options...';
itmProjectOptions.OnClick := @mnuProjectOptionsClicked;
mnuProject.Add(itmProjectOptions);
//--------------
// Run
//--------------
itmProjectBuild := TMenuItem.Create(Self);
itmProjectBuild.Name:='itmProjectBuild';
itmProjectBuild.Caption := 'Build';
itmProjectBuild.OnClick := @mnuBuildProjectClicked;
mnuRun.Add(itmProjectBuild);
itmProjectRun := TMenuItem.Create(Self);
itmProjectRun.Name:='itmProjectRun';
itmProjectRun.Caption := 'Run';
itmProjectRun.OnClick := @mnuRunProjectClicked;
mnuRun.Add(itmProjectRun);
itmProjectPause := TMenuItem.Create(Self);
itmProjectPause.Name:='itmProjectPause';
itmProjectPause.Caption := 'Pause';
itmProjectPause.OnClick := @mnuPauseProjectClicked;
itmProjectPause.Enabled := false;
mnuRun.Add(itmProjectPause);
itmProjectStepInto := TMenuItem.Create(Self);
itmProjectStepInto.Name:='itmProjectStepInto';
itmProjectStepInto.Caption := 'Step into';
itmProjectStepInto.OnClick := @mnuStepIntoProjectClicked;
mnuRun.Add(itmProjectStepInto);
itmProjectStepOver := TMenuItem.Create(Self);
itmProjectStepOver.Name:='itmProjectStepOver';
itmProjectStepOver.Caption := 'Step over';
itmProjectStepOver.OnClick := @mnuStepOverProjectClicked;
mnuRun.Add(itmProjectStepOver);
itmProjectRunToCursor := TMenuItem.Create(Self);
itmProjectRunToCursor.Name:='itmProjectRunToCursor';
itmProjectRunToCursor.Caption := 'Run to cursor';
itmProjectRunToCursor.OnClick := @mnuRunToCursorProjectClicked;
mnuRun.Add(itmProjectRunToCursor);
itmProjectStop := TMenuItem.Create(Self);
itmProjectStop.Name:='itmProjectStop';
itmProjectStop.Caption := 'Stop';
itmProjectStop.OnClick := @mnuStopProjectClicked;
mnuRun.Add(itmProjectStop);
mnuRun.Add(CreateSeperator);
itmProjectCompilerSettings := TMenuItem.Create(Self);
itmProjectCompilerSettings.Name:='itmProjectCompilerSettings';
itmProjectCompilerSettings.Caption := 'Compiler Options...';
itmProjectCompilerSettings.OnClick := @mnuProjectCompilerSettingsClicked;
mnuRun.Add(itmProjectCompilerSettings);
//--------------
// Environment
//--------------
@ -2074,6 +2087,11 @@ if ResourceCode<>nil then writeln('*** ResourceFileName ',ResourceCode.Filename)
ChangeFileExt(NewFilename,'.lfm'),LFMCode) then
LFMCode:=nil;
end;
end else begin
// removing support files
// The IDE automatically opens lfm files. SaveAs makes sure, that there
// is no old lfm file left, which does not belong to the file
DeleteFile(ChangeFileExt(NewFilename,'.lfm'));
end;
{$IFDEF IDE_DEBUG}
writeln('TMainIDE.DoSaveEditorUnit C ',ResourceCode<>nil);
@ -2101,8 +2119,11 @@ writeln('TMainIDE.DoSaveEditorUnit C ',ResourceCode<>nil);
end;
TestFilename:='';
if not SaveToTestDir then begin
if ActiveUnitInfo.Modified and not SaveAs then begin
if ActiveUnitInfo.Modified then begin
// save source
{writeln('');
writeln(ActiveUnitInfo.Source.Source);
writeln('');}
Result:=ActiveUnitInfo.WriteUnitSource;
if Result=mrAbort then exit;
end;
@ -3190,6 +3211,30 @@ Begin
Result:=mrOk;
end;
function TMainIDE.DoSaveProjectToTestDirectory: TModalResult;
begin
Result:=mrCancel;
if (EnvironmentOptions.TestBuildDirectory='')
or (not DirectoryExists(EnvironmentOptions.TestBuildDirectory)) then begin
if (EnvironmentOptions.TestBuildDirectory<>'') then begin
MessageDlg('The Test Directory could not be found:'#13
+'"'+EnvironmentOptions.TestBuildDirectory+'"'#13
+'(see environment options)',mtError,[mbCancel],0);
Result:=mrCancel;
exit;
end;
Result:=MessageDlg('Build new project',
'The project must be saved before building'#13
+'If you set the Test Directory in the environment options,'#13
+'you can create new projects and build them at once.'#13
+'Save project?',mtInformation,[mbOk,mbCancel],0);
if Result<>mrOk then exit;
Result:=DoSaveAll;
exit;
end;
Result:=DoSaveProject(false,true);
end;
function TMainIDE.DoBuildProject: TModalResult;
var ActiveSrcEdit: TSourceEditor;
DefaultFilename: string;
@ -3206,12 +3251,12 @@ begin
try
if not (Project.ProjectType in [ptProgram, ptApplication, ptCustomProgram])
then exit;
if Project.ProjectFile<>'' then
if not Project.IsVirtual then
Result:=DoSaveAll
else
Result:=DoSaveProjectToTestDirectory;
if Result<>mrOk then exit;
if Project.ProjectFile<>'' then
if not Project.IsVirtual then
DefaultFilename:=''
else
DefaultFilename:=GetTestUnitFilename(Project.Units[Project.MainUnit]);
@ -3239,25 +3284,10 @@ begin
end;
end;
function TMainIDE.DoSaveProjectToTestDirectory: TModalResult;
begin
Result:=mrCancel;
if (EnvironmentOptions.TestBuildDirectory='')
or (not DirectoryExists(EnvironmentOptions.TestBuildDirectory)) then begin
Result:=DoSaveAll;
exit;
end;
Result:=DoSaveProject(false,true);
end;
function TMainIDE.DoRunProject: TModalResult;
// quick hack to start programs
// ToDo:
// -switch the IDE mode to running and free the process when program terminates
// -implement a better messages form for vast amount of output
// -target filename
// -implement a better messages-form for vast amount of output
// -command line parameters
// -connect program to debugger
var
TheProcess : TProcess;
ProgramFilename, AText : String;
@ -3274,10 +3304,13 @@ writeln('[TMainIDE.DoRunProject] A');
exit;
MainUnitInfo:=Project.Units[Project.MainUnit];
if MainUnitInfo.IsVirtual then
if Project.IsVirtual then
ProgramFilename:=GetTestProjectFilename
else
ProgramFilename:=ChangeFileExt(MainUnitInfo.Filename,Project.TargetFileExt);
else begin
ProgramFilename:=
Project.CompilerOptions.CreateTargetFilename(MainUnitInfo.Filename);
end;
if not FileExists(ProgramFilename) then begin
AText:='No program file "'+ProgramFilename+'" found!';
@ -3987,18 +4020,12 @@ begin
end;
function TMainIDE.GetTestProjectFilename: string;
var TestDir: string;
begin
Result:='';
if (Project.MainUnit<0) then exit;
Result:=lowercase(
CodeToolBoss.GetSourceName(Project.Units[Project.MainUnit].Source));
if (Result='') then exit;
TestDir:=EnvironmentOptions.TestBuildDirectory;
if (TestDir='') then exit;
if TestDir[length(TestDir)]<>OSDirSeparator then
TestDir:=TestDir+OSDirSeparator;
Result:=TestDir+Result;
Result:=GetTestUnitFilename(Project.Units[Project.MainUnit]);
if Result='' then exit;
Result:=Project.CompilerOptions.CreateTargetFilename(Result);
end;
function TMainIDE.GetTestUnitFilename(AnUnitInfo: TUnitInfo): string;
@ -4382,6 +4409,9 @@ end.
{ =============================================================================
$Log$
Revision 1.135 2001/11/05 18:18:13 lazarus
added popupmenu+arrows to notebooks, added target filename
Revision 1.134 2001/11/05 00:12:50 lazarus
MWE: First steps of a debugger.
@ -9012,6 +9042,9 @@ end.
{ =============================================================================
$Log$
Revision 1.135 2001/11/05 18:18:13 lazarus
added popupmenu+arrows to notebooks, added target filename
Revision 1.134 2001/11/05 00:12:50 lazarus
MWE: First steps of a debugger.

40
ide/project.pp
View File

@ -215,14 +215,16 @@ type
fUnitList: TList; // list of TUnitInfo
fUnitOutputDirectory: String;
function GetProjectInfoFile: string;
function GetTargetFilename: string;
function GetUnits(Index:integer):TUnitInfo;
procedure SetUnits(Index:integer; AUnitInfo: TUnitInfo);
procedure SetProjectFile(const NewProjectFilename: string);
procedure SetProjectInfoFile(const NewFilename:string);
procedure SetTargetFilename(const NewTargetFilename: string);
procedure OnLoadSaveFilename(var AFilename:string; Load:boolean);
function OnUnitFileBackup(const Filename:string;
IsPartOfProject:boolean):TModalResult;
function GetProjectInfoFile:string;
procedure SetProjectInfoFile(const NewFilename:string);
procedure OnLoadSaveFilename(var AFilename:string; Load:boolean);
procedure OnUnitNameChange(AnUnitInfo: TUnitInfo;
const OldUnitName, NewUnitName: string; var Allowed: boolean);
public
@ -274,6 +276,7 @@ type
read GetProjectInfoFile write SetProjectInfoFile;
property ProjectType: TProjectType read fProjectType write fProjectType;
property TargetFileExt: String read fTargetFileExt write fTargetFileExt;
property TargetFilename: string read GetTargetFilename write SetTargetFilename;
property Title: String read fTitle write fTitle;
property UnitOutputDirectory: String
read fUnitOutputDirectory write fUnitOutputDirectory;
@ -1394,21 +1397,22 @@ begin
Modified:=true;
end;
function TProject.GetTargetFilename: string;
begin
Result:=fCompilerOptions.TargetFilename;
end;
procedure TProject.SetTargetFilename(const NewTargetFilename: string);
begin
fCompilerOptions.TargetFilename:=NewTargetFilename;
end;
procedure TProject.SetProjectFile(const NewProjectFilename: string);
begin
fProjectFile:=NewProjectFilename;
Modified:=true;
end;
function TProject.OnUnitFileBackup(const Filename:string;
IsPartOfProject:boolean):TModalResult;
begin
if Assigned(fOnFileBackup) then
Result:=fOnFileBackup(Filename,IsPartOfProject)
else
Result:=mrOk;
end;
function TProject.GetProjectInfoFile:string;
begin
Result:=fProjectFile;
@ -1421,6 +1425,15 @@ begin
ProjectFile:=ChangeFileExt(NewFilename,ProjectDefaultExt[ProjectType]);
end;
function TProject.OnUnitFileBackup(const Filename:string;
IsPartOfProject:boolean):TModalResult;
begin
if Assigned(fOnFileBackup) then
Result:=fOnFileBackup(Filename,IsPartOfProject)
else
Result:=mrOk;
end;
procedure TProject.OnLoadSaveFilename(var AFilename:string; Load:boolean);
var ProjectPath:string;
begin
@ -1476,6 +1489,9 @@ end.
{
$Log$
Revision 1.34 2001/11/05 18:18:18 lazarus
added popupmenu+arrows to notebooks, added target filename
Revision 1.33 2001/11/03 08:37:35 lazarus
MG: fixed errorline showing, resource adding and published var editing and added make cleanall

7
ide/projectopts.pp
View File

@ -199,7 +199,6 @@ begin
Top:=1;
Width:=100;
Height:=23;
Enabled:=false;
Caption:='Target file name:';
Visible:=true;
end;
@ -212,7 +211,6 @@ begin
Top:=TargetFileLabel.Top+4;
Width:=OutputSettingsGroupBox.Width-Left-10;
Text:='';
Enabled:=false;
Visible:=true;
end;
end;
@ -343,6 +341,7 @@ begin
if AProject=nil then exit;
with AProject do begin
TitleEdit.Text:=Title;
TargetFileEdit.Text:=TargetFilename;
end;
FillAutoCreateFormsListbox;
FillAvailFormsListBox;
@ -352,6 +351,7 @@ procedure TProjectOptionsDialog.OkButtonClick(Sender: TObject);
begin
with FProject do begin
Title:=TitleEdit.Text;
TargetFilename:=TargetFileEdit.Text;
end;
SetAutoCreateForms;
ModalResult:=mrOk;
@ -557,7 +557,8 @@ begin
try
if OldList.Count=FormsAutoCreatedListBox.Items.Count then begin
i:=OldList.Count-1;
while AnsiCompareText(OldList[i],FormsAutoCreatedListBox.Items[i])=0 do
while (i>=0)
and (AnsiCompareText(OldList[i],FormsAutoCreatedListBox.Items[i])=0) do
dec(i);
if i<0 then exit;
end;

2
ide/uniteditor.pp
View File

@ -951,7 +951,7 @@ end;
procedure TSourceEditor.SetErrorLine(NewLine: integer);
begin
writeln('[TSourceEditor.SetErrorLine] ',NewLine,',',fErrorLine);
//writeln('[TSourceEditor.SetErrorLine] ',NewLine,',',fErrorLine);
if fErrorLine=NewLine then exit;
fErrorLine:=NewLine;
fErrorColumn:=EditorComponent.CaretX;

27
lcl/extctrls.pp
View File

@ -109,23 +109,23 @@ type
}
TCustomNotebook = class(TCustomControl)
private
fPageList: TList; // TList of TPage
fAccess: TStrings; // TNBPages
fPageIndex: Integer;
fPageList: TList; // List of TPage
//fMultiLine: boolean;
fOnPageChanged: TNotifyEvent;
{ Extra variables not in Delphi }
fShowTabs: Boolean;
fTabPosition: TTabPosition;
Procedure CNNotify(var Message : TLMNotify); message CN_NOTIFY;
function GetActivePage: String;
function GetPage(aIndex: Integer): TPage;
function GetPageIndex: Integer;
//function InternalSetMultiLine(Value: boolean): boolean;
procedure SetActivePage(const Value: String);
//procedure SetMultiLine(Value: boolean);
procedure SetPageIndex(Value: Integer);
procedure SetPages(Value: TStrings);
Procedure CNNotify(var Message : TLMNotify); message CN_NOTIFY;
{ Extra private methods not in Delphi }
function GetPage(aIndex: Integer): TPage;
procedure SetShowTabs(Value: Boolean);
procedure SetTabPosition(tabPos: TTabPosition);
protected
@ -138,13 +138,12 @@ type
procedure ShowControl(AControl: TControl); override;
property ActivePage: String read GetActivePage write SetActivePage;
//property MultiLine: boolean read fMultiLine write SetMultiLine default false;
property Page[Index: Integer]: TPage read GetPage;
property PageIndex: Integer read GetPageIndex write SetPageIndex default 0;
property PageList: TList read fPageList;
property Pages: TStrings read fAccess write SetPages;
property OnPageChanged: TNotifyEvent read fOnPageChanged write fOnPageChanged;
{ Extra properties not in Delphi - Move to TabbedNotebook when it is created }
property Page[Index: Integer]: TPage read GetPage;
property PageList: TList read fPageList;
property ShowTabs: Boolean read fShowTabs write SetShowTabs;
property TabPosition: TTabPosition read fTabPosition write SetTabPosition;
public
@ -166,9 +165,11 @@ type
property Pages;
published
property ActivePage;
//property MultiLine;
property OnPageChanged;
property PageIndex;
property PageList;
property OnPageChanged;
property ShowTabs;
end;
@ -334,8 +335,8 @@ end.
{
$Log$
Revision 1.13 2001/10/19 14:27:43 lazarus
MG: fixed customradiogroup OnClick + ItemIndex
Revision 1.14 2001/11/05 18:18:19 lazarus
added popupmenu+arrows to notebooks, added target filename
Revision 1.12 2001/06/26 21:44:32 lazarus
MG: reduced paint messages

7
lcl/include/application.inc
View File

@ -17,7 +17,9 @@ begin
FIcon := nil;
inherited Create(AOwner);
ExceptProc := @ExceptionOccurred;
// MG: if you prefer message boxes instead of terminal error messages uncomment
// the following line
//ExceptProc := @ExceptionOccurred;
end;
{------------------------------------------------------------------------------}
@ -343,6 +345,9 @@ end;
{ =============================================================================
$Log$
Revision 1.13 2001/11/05 18:18:19 lazarus
added popupmenu+arrows to notebooks, added target filename
Revision 1.12 2001/11/01 21:30:35 lazarus
Changes to Messagebox.
Added line to CodeTools to prevent duplicate USES entries.

32
lcl/include/customnotebook.inc
View File

@ -1,3 +1,5 @@
// included by extctrls.pp
{******************************************************************************
TNBPages
******************************************************************************}
@ -237,8 +239,7 @@ writeln('[TCustomNotebook.CreateWnd] B');
{$ENDIF}
Assert(False, 'Trace:[TCustomNotebook.CreateWnd] add pages');
for n := 0 to FPageList.Count -1 do
begin
for n := 0 to FPageList.Count -1 do begin
// this is workaround til visible=true is default in TControl
TControl(FPageList[n]).Visible:=true;
Msg.Parent := Self;
@ -496,10 +497,37 @@ Begin
end;
end;
{------------------------------------------------------------------------------
TCustomNotebook InternalSetMultiLine
------------------------------------------------------------------------------}
{function TCustomNotebook.InternalSetMultiLine(Value: boolean): boolean;
begin
Result := FMultiLine <> Value;
if Result then begin
if not Value and ((TabPosition = tpLeft) or (TabPosition = tpRight)) then
raise Exception.Create(
'TCustomNotebook.InternalSetMultiLine: Tab must be multiline');
FMultiLine := Value;
//if not Value then FScrollOpposite := False;
end;
end;}
{------------------------------------------------------------------------------
TCustomNotebook SetMultiLine
------------------------------------------------------------------------------}
{procedure TCustomNotebook.SetMultiLine(Value: boolean);
begin
if InternalSetMultiLine(Value) then RecreateWnd;
end;}
{ =============================================================================
$Log$
Revision 1.11 2001/11/05 18:18:19 lazarus
added popupmenu+arrows to notebooks, added target filename
Revision 1.10 2001/10/16 10:51:10 lazarus
MG: added clicked event to TButton, MessageDialog reacts to return key

5
lcl/interfaces/gtk/gtkobject.inc
View File

@ -2157,6 +2157,8 @@ begin
csNotebook :
begin
P := gtk_notebook_new();
gtk_notebook_set_scrollable(P, true);
gtk_notebook_popup_enable(P);
gtk_notebook_set_show_tabs(P, false); // Turn tabs off
{
@ -3113,6 +3115,9 @@ end;
{ =============================================================================
$Log$
Revision 1.66 2001/11/05 18:18:19 lazarus
added popupmenu+arrows to notebooks, added target filename
Revision 1.65 2001/11/01 21:30:35 lazarus
Changes to Messagebox.
Added line to CodeTools to prevent duplicate USES entries.