mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-11 09:36:10 +02:00
added Kylix 3 specials
git-svn-id: trunk@4595 -
This commit is contained in:
mattias
parent
731901b4e8
commit
61d1cf358a
@ -354,6 +354,7 @@ type
|
||||
procedure Move(SrcIndex, DestIndex: integer);
|
||||
property EnglishErrorMsgFilename: string
|
||||
read FEnglishErrorMsgFilename write SetEnglishErrorMsgFilename;
|
||||
// FPC templates
|
||||
function CreateFPCTemplate(const PPC386Path, PPCOptions,
|
||||
TestPascalFile: string;
|
||||
var UnitSearchPath: string;
|
||||
@ -361,23 +362,35 @@ type
|
||||
function CreateFPCSrcTemplate(const FPCSrcDir, UnitSearchPath, PPUExt: string;
|
||||
UnitLinkListValid: boolean; var UnitLinkList: string;
|
||||
Owner: TObject): TDefineTemplate;
|
||||
function CreateFPCCommandLineDefines(const Name, CmdLine: string;
|
||||
RecursiveDefines: boolean;
|
||||
Owner: TObject): TDefineTemplate;
|
||||
// Lazarus templates
|
||||
function CreateLazarusSrcTemplate(
|
||||
const LazarusSrcDir, WidgetType, ExtraOptions: string;
|
||||
Owner: TObject): TDefineTemplate;
|
||||
function CreateLCLProjectTemplate(const LazarusSrcDir, WidgetType,
|
||||
ProjectDir: string; Owner: TObject): TDefineTemplate;
|
||||
// Delphi templates
|
||||
function CreateDelphiSrcPath(DelphiVersion: integer;
|
||||
const PathPrefix: string): string;
|
||||
function CreateDelphiCompilerDefinesTemplate(DelphiVersion: integer;
|
||||
Owner: TObject): TDefineTemplate;
|
||||
Owner: TObject): TDefineTemplate;
|
||||
function CreateDelphiDirectoryTemplate(const DelphiDirectory: string;
|
||||
DelphiVersion: integer; Owner: TObject): TDefineTemplate;
|
||||
function CreateDelphiProjectTemplate(const ProjectDir,
|
||||
DelphiDirectory: string; DelphiVersion: integer;
|
||||
Owner: TObject): TDefineTemplate;
|
||||
function CreateFPCCommandLineDefines(const Name, CmdLine: string;
|
||||
RecursiveDefines: boolean;
|
||||
Owner: TObject): TDefineTemplate;
|
||||
// Kylix templates
|
||||
function CreateKylixCompilerDefinesTemplate(KylixVersion: integer;
|
||||
Owner: TObject): TDefineTemplate;
|
||||
function CreateKylixSrcPath(KylixVersion: integer;
|
||||
const PathPrefix: string): string;
|
||||
function CreateKylixDirectoryTemplate(const KylixDirectory: string;
|
||||
KylixVersion: integer; Owner: TObject): TDefineTemplate;
|
||||
function CreateKylixProjectTemplate(const ProjectDir,
|
||||
KylixDirectory: string; KylixVersion: integer;
|
||||
Owner: TObject): TDefineTemplate;
|
||||
procedure Clear;
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
@ -3072,17 +3085,18 @@ function TDefinePool.CreateDelphiSrcPath(DelphiVersion: integer;
|
||||
const PathPrefix: string): string;
|
||||
begin
|
||||
case DelphiVersion of
|
||||
6:
|
||||
1..5:
|
||||
Result:=PathPrefix+'Source/Rtl/Win;'
|
||||
+PathPrefix+'Source/Rtl/Sys;'
|
||||
+PathPrefix+'Source/Rtl/Corba;'
|
||||
+PathPrefix+'Source/Vcl;';
|
||||
else
|
||||
// 6 and above
|
||||
Result:=PathPrefix+'Source/Rtl/Win;'
|
||||
+PathPrefix+'Source/Rtl/Sys;'
|
||||
+PathPrefix+'Source/Rtl/Common;'
|
||||
+PathPrefix+'Source/Rtl/Corba40;'
|
||||
+PathPrefix+'Source/Vcl;';
|
||||
else
|
||||
Result:=PathPrefix+'Source/Rtl/Win;'
|
||||
+PathPrefix+'Source/Rtl/Sys;'
|
||||
+PathPrefix+'Source/Rtl/Corba;'
|
||||
+PathPrefix+'Source/Vcl;';
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -3458,7 +3472,8 @@ end;
|
||||
|
||||
function TDefinePool.CreateDelphiCompilerDefinesTemplate(
|
||||
DelphiVersion: integer; Owner: TObject): TDefineTemplate;
|
||||
var DefTempl: TDefineTemplate;
|
||||
var
|
||||
DefTempl: TDefineTemplate;
|
||||
begin
|
||||
DefTempl:=TDefineTemplate.Create('Delphi'+IntToStr(DelphiVersion)
|
||||
+' Compiler Defines',
|
||||
@ -3482,20 +3497,24 @@ begin
|
||||
3:
|
||||
DefTempl.AddChild(TDefineTemplate.Create('Define macro VER_110',
|
||||
Format(ctsDefineMacroName,['VER_110']),
|
||||
'VER_130','',da_DefineRecurse));
|
||||
'VER_110','',da_DefineRecurse));
|
||||
4:
|
||||
DefTempl.AddChild(TDefineTemplate.Create('Define macro VER_125',
|
||||
Format(ctsDefineMacroName,['VER_125']),
|
||||
'VER_130','',da_DefineRecurse));
|
||||
'VER_125','',da_DefineRecurse));
|
||||
5:
|
||||
DefTempl.AddChild(TDefineTemplate.Create('Define macro VER_130',
|
||||
Format(ctsDefineMacroName,['VER_130']),
|
||||
'VER_130','',da_DefineRecurse));
|
||||
else
|
||||
// else define Delphi 6
|
||||
6:
|
||||
DefTempl.AddChild(TDefineTemplate.Create('Define macro VER_140',
|
||||
Format(ctsDefineMacroName,['VER_140']),
|
||||
'VER_140','',da_DefineRecurse));
|
||||
else
|
||||
// else define Delphi 7
|
||||
DefTempl.AddChild(TDefineTemplate.Create('Define macro VER_150',
|
||||
Format(ctsDefineMacroName,['VER_150']),
|
||||
'VER_150','',da_DefineRecurse));
|
||||
end;
|
||||
|
||||
DefTempl.AddChild(TDefineTemplate.Create(
|
||||
@ -3553,6 +3572,113 @@ begin
|
||||
Result.SetDefineOwner(Owner,true);
|
||||
end;
|
||||
|
||||
function TDefinePool.CreateKylixCompilerDefinesTemplate(KylixVersion: integer;
|
||||
Owner: TObject): TDefineTemplate;
|
||||
var
|
||||
DefTempl: TDefineTemplate;
|
||||
begin
|
||||
DefTempl:=TDefineTemplate.Create('Kylix'+IntToStr(KylixVersion)
|
||||
+' Compiler Defines',
|
||||
Format(ctsOtherCompilerDefines,['Kylix'+IntToStr(KylixVersion)]),
|
||||
'','',da_Block);
|
||||
DefTempl.AddChild(TDefineTemplate.Create('Reset',
|
||||
ctsResetAllDefines,
|
||||
'','',da_UndefineAll));
|
||||
DefTempl.AddChild(TDefineTemplate.Create('Define macro KYLIX',
|
||||
Format(ctsDefineMacroName,['KYLIX']),
|
||||
'KYLIX','',da_DefineRecurse));
|
||||
DefTempl.AddChild(TDefineTemplate.Create('Define macro FPC_DELPHI',
|
||||
Format(ctsDefineMacroName,['FPC_DELPHI']),
|
||||
'FPC_DELPHI','',da_DefineRecurse));
|
||||
DefTempl.AddChild(TDefineTemplate.Create('Define macro LINUX',
|
||||
Format(ctsDefineMacroName,['LINUX']),
|
||||
'LINUX','',da_DefineRecurse));
|
||||
DefTempl.AddChild(TDefineTemplate.Create('Define macro CPU386',
|
||||
Format(ctsDefineMacroName,['CPU386']),
|
||||
'CPU386','',da_DefineRecurse));
|
||||
|
||||
// version
|
||||
case KylixVersion of
|
||||
1:
|
||||
DefTempl.AddChild(TDefineTemplate.Create('Define macro VER_125',
|
||||
Format(ctsDefineMacroName,['VER_125']),
|
||||
'VER_125','',da_DefineRecurse));
|
||||
2:
|
||||
DefTempl.AddChild(TDefineTemplate.Create('Define macro VER_130',
|
||||
Format(ctsDefineMacroName,['VER_130']),
|
||||
'VER_130','',da_DefineRecurse));
|
||||
else
|
||||
// else define Kylix 3
|
||||
DefTempl.AddChild(TDefineTemplate.Create('Define macro VER_140',
|
||||
Format(ctsDefineMacroName,['VER_140']),
|
||||
'VER_140','',da_DefineRecurse));
|
||||
end;
|
||||
|
||||
DefTempl.AddChild(TDefineTemplate.Create(
|
||||
Format(ctsDefineMacroName,[ExternalMacroStart+'Compiler']),
|
||||
'Define '+ExternalMacroStart+'Compiler variable',
|
||||
ExternalMacroStart+'Compiler','DELPHI',da_DefineRecurse));
|
||||
|
||||
Result:=DefTempl;
|
||||
Result.SetDefineOwner(Owner,true);
|
||||
end;
|
||||
|
||||
function TDefinePool.CreateKylixSrcPath(KylixVersion: integer;
|
||||
const PathPrefix: string): string;
|
||||
begin
|
||||
Result:=PathPrefix+'source/rtl/linux;'
|
||||
+PathPrefix+'source/rtl/sys;'
|
||||
+PathPrefix+'source/rtl/common;'
|
||||
+PathPrefix+'source/rtl/corba40;'
|
||||
+PathPrefix+'source/rtle;'
|
||||
+PathPrefix+'source/rtl/clx';
|
||||
end;
|
||||
|
||||
function TDefinePool.CreateKylixDirectoryTemplate(const KylixDirectory: string;
|
||||
KylixVersion: integer; Owner: TObject): TDefineTemplate;
|
||||
var MainDirTempl: TDefineTemplate;
|
||||
begin
|
||||
MainDirTempl:=TDefineTemplate.Create('Kylix'+IntToStr(KylixVersion)
|
||||
+' Directory',
|
||||
Format(ctsNamedDirectory,['Kylix'+IntToStr(KylixVersion)]),
|
||||
'',KylixDirectory,da_Directory);
|
||||
MainDirTempl.AddChild(CreateKylixCompilerDefinesTemplate(KylixVersion,Owner));
|
||||
MainDirTempl.AddChild(TDefineTemplate.Create('SrcPath',
|
||||
Format(ctsSetsSrcPathTo,['RTL, CLX']),
|
||||
ExternalMacroStart+'SrcPath',
|
||||
SetDirSeparators(CreateKylixSrcPath(KylixVersion,'$(#DefinePath)/')
|
||||
+'$(#SrcPath)'),
|
||||
da_DefineRecurse));
|
||||
|
||||
Result:=MainDirTempl;
|
||||
Result.SetDefineOwner(Owner,true);
|
||||
end;
|
||||
|
||||
function TDefinePool.CreateKylixProjectTemplate(const ProjectDir,
|
||||
KylixDirectory: string; KylixVersion: integer; Owner: TObject
|
||||
): TDefineTemplate;
|
||||
var MainDirTempl: TDefineTemplate;
|
||||
begin
|
||||
MainDirTempl:=TDefineTemplate.Create('Kylix'+IntToStr(KylixVersion)+' Project',
|
||||
Format(ctsNamedProject,['Kylix'+IntToStr(KylixVersion)]),
|
||||
'',ProjectDir,da_Directory);
|
||||
MainDirTempl.AddChild(
|
||||
CreateDelphiCompilerDefinesTemplate(KylixVersion,Owner));
|
||||
MainDirTempl.AddChild(TDefineTemplate.Create(
|
||||
'Define '+ExternalMacroStart+'KylixDir',
|
||||
Format(ctsDefineMacroName,[ExternalMacroStart+'KylixDir']),
|
||||
ExternalMacroStart+'KylixDir',KylixDirectory,da_DefineRecurse));
|
||||
MainDirTempl.AddChild(TDefineTemplate.Create('SrcPath',
|
||||
Format(ctsAddsDirToSourcePath,['Kylix RTL+VCL']),
|
||||
ExternalMacroStart+'SrcPath',
|
||||
SetDirSeparators(CreateKylixSrcPath(KylixVersion,'$(#KylixDir)/')
|
||||
+'$(#SrcPath)'),
|
||||
da_DefineRecurse));
|
||||
|
||||
Result:=MainDirTempl;
|
||||
Result.SetDefineOwner(Owner,true);
|
||||
end;
|
||||
|
||||
function TDefinePool.CreateFPCCommandLineDefines(const Name, CmdLine: string;
|
||||
RecursiveDefines: boolean; Owner: TObject): TDefineTemplate;
|
||||
|
||||
|
||||
@ -1268,6 +1268,27 @@ var UnitSrcSearchPath: string;
|
||||
MainCodeIsVirtual: boolean;
|
||||
CompiledResult: TCodeBuffer;
|
||||
UnitSearchPath: string;
|
||||
SrcPathInitialized: boolean;
|
||||
|
||||
procedure InitSrcPath;
|
||||
begin
|
||||
if SrcPathInitialized then exit;
|
||||
SrcPathInitialized:=true;
|
||||
if Assigned(OnGetUnitSourceSearchPath) then begin
|
||||
UnitSearchPath:='';
|
||||
UnitSrcSearchPath:=OnGetUnitSourceSearchPath(Self);
|
||||
end else begin
|
||||
UnitSearchPath:=Scanner.Values[ExternalMacroStart+'UnitPath'];
|
||||
UnitSrcSearchPath:=Scanner.Values[ExternalMacroStart+'SrcPath'];
|
||||
if UnitSearchPath<>'' then begin
|
||||
if UnitSrcSearchPath<>'' then
|
||||
UnitSrcSearchPath:=UnitSrcSearchPath+';'+UnitSearchPath
|
||||
else
|
||||
UnitSrcSearchPath:=UnitSearchPath;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
{$IFDEF ShowTriedFiles}
|
||||
writeln('TFindDeclarationTool.FindUnitSource A AnUnitName=',AnUnitName,' AnUnitInFilename=',AnUnitInFilename);
|
||||
@ -1277,18 +1298,9 @@ begin
|
||||
or (not (TObject(Scanner.MainCode) is TCodeBuffer))
|
||||
or (Scanner.OnLoadSource=nil) then
|
||||
exit;
|
||||
if Assigned(OnGetUnitSourceSearchPath) then
|
||||
UnitSrcSearchPath:=OnGetUnitSourceSearchPath(Self)
|
||||
else begin
|
||||
UnitSearchPath:=Scanner.Values[ExternalMacroStart+'UnitPath'];
|
||||
UnitSrcSearchPath:=Scanner.Values[ExternalMacroStart+'SrcPath'];
|
||||
if UnitSearchPath<>'' then begin
|
||||
if UnitSrcSearchPath<>'' then
|
||||
UnitSrcSearchPath:=UnitSrcSearchPath+';'+UnitSearchPath
|
||||
else
|
||||
UnitSrcSearchPath:=UnitSearchPath;
|
||||
end;
|
||||
end;
|
||||
SrcPathInitialized:=false;
|
||||
UnitSearchPath:='';
|
||||
UnitSrcSearchPath:='';
|
||||
{$IFDEF ShowSearchPaths}
|
||||
writeln('TFindDeclarationTool.FindUnitSource ',
|
||||
' Self="',MainFilename,'"',
|
||||
@ -1314,6 +1326,7 @@ begin
|
||||
CurDir:=AppendPathDelim(CurDir);
|
||||
if not LoadFile(CurDir+AnUnitInFilename,Result) then begin
|
||||
// search AnUnitInFilename in searchpath
|
||||
InitSrcPath;
|
||||
Result:=SearchFileInPath(UnitSrcSearchPath,AnUnitInFilename);
|
||||
end;
|
||||
end;
|
||||
@ -1329,6 +1342,7 @@ begin
|
||||
{$IFDEF ShowTriedFiles}
|
||||
writeln('TFindDeclarationTool.FindUnitSource Search in search path=',UnitSrcSearchPath);
|
||||
{$ENDIF}
|
||||
InitSrcPath;
|
||||
Result:=SearchUnitFileInPath(UnitSrcSearchPath,AnUnitName,true);
|
||||
end;
|
||||
if Result=nil then begin
|
||||
@ -1344,6 +1358,7 @@ begin
|
||||
{$IFDEF ShowTriedFiles}
|
||||
writeln('TFindDeclarationTool.FindUnitSource Search Compiled unit in src path=',UnitSrcSearchPath);
|
||||
{$ENDIF}
|
||||
InitSrcPath;
|
||||
CompiledResult:=SearchUnitFileInPath(UnitSrcSearchPath,AnUnitName,false);
|
||||
end;
|
||||
if CompiledResult=nil then begin
|
||||
@ -3530,15 +3545,19 @@ begin
|
||||
ReadNextAtom;
|
||||
ReadNextAtom;
|
||||
SystemAlias:='SYSTEM';
|
||||
if (Scanner.PascalCompiler<>pcDelphi)
|
||||
and Scanner.InitialValues.IsDefined('VER1_0')
|
||||
then begin
|
||||
if Scanner.InitialValues.IsDefined('LINUX') then
|
||||
SystemAlias:='SYSLINUX'
|
||||
else if Scanner.InitialValues.IsDefined('BSD') then
|
||||
SystemAlias:='SYSBSD'
|
||||
else if Scanner.InitialValues.IsDefined('WIN32') then
|
||||
SystemAlias:='SYSWIN32';
|
||||
if (Scanner.PascalCompiler=pcDelphi) then begin
|
||||
SystemAlias:='System';
|
||||
end else begin
|
||||
// FPC
|
||||
if Scanner.InitialValues.IsDefined('VER1_0')
|
||||
then begin
|
||||
if Scanner.InitialValues.IsDefined('LINUX') then
|
||||
SystemAlias:='SYSLINUX'
|
||||
else if Scanner.InitialValues.IsDefined('BSD') then
|
||||
SystemAlias:='SYSBSD'
|
||||
else if Scanner.InitialValues.IsDefined('WIN32') then
|
||||
SystemAlias:='SYSWIN32';
|
||||
end;
|
||||
end;
|
||||
if UpAtomIs(SystemAlias) or UpAtomIs('SYSTEM') then
|
||||
CurUnitType:=sutSystem
|
||||
@ -3568,7 +3587,7 @@ begin
|
||||
if (CurUnitType>sutObjPas)
|
||||
and (Scanner.CompilerMode in [cmDELPHI,cmOBJFPC])
|
||||
and (Scanner.PascalCompiler=pcFPC) then begin
|
||||
// try hidden used unit 'objpas'
|
||||
// try hidden used fpc unit 'objpas'
|
||||
Result:=FindIdentifierInUsedUnit('ObjPas',Params);
|
||||
if Result then exit;
|
||||
end;
|
||||
|
||||
@ -651,6 +651,7 @@ begin
|
||||
Add('REGISTER' ,{$ifdef FPC}@{$endif}AllwaysTrue);
|
||||
Add('SAVEREGISTERS',{$ifdef FPC}@{$endif}AllwaysTrue);
|
||||
Add('STDCALL' ,{$ifdef FPC}@{$endif}AllwaysTrue);
|
||||
Add('VARARGS' ,{$ifdef FPC}@{$endif}AllwaysTrue); // kylix
|
||||
Add('[' ,{$ifdef FPC}@{$endif}AllwaysTrue);
|
||||
end;
|
||||
|
||||
|
||||
@ -234,6 +234,8 @@ type
|
||||
function IfOptDirective: boolean;
|
||||
function EndifDirective: boolean;
|
||||
function ElseDirective: boolean;
|
||||
function ElseIfDirective: boolean;
|
||||
function IfEndDirective: boolean;
|
||||
function DefineDirective: boolean;
|
||||
function UndefDirective: boolean;
|
||||
function IncludeDirective: boolean;
|
||||
@ -1958,6 +1960,8 @@ begin
|
||||
Add('IFOPT',{$ifdef FPC}@{$endif}IfOptDirective);
|
||||
Add('ENDIF',{$ifdef FPC}@{$endif}EndIfDirective);
|
||||
Add('ELSE',{$ifdef FPC}@{$endif}ElseDirective);
|
||||
Add('ELSEIF',{$ifdef FPC}@{$endif}ElseIfDirective);
|
||||
Add('IFEND',{$ifdef FPC}@{$endif}IfEndDirective);
|
||||
Add('DEFINE',{$ifdef FPC}@{$endif}DefineDirective);
|
||||
Add('UNDEF',{$ifdef FPC}@{$endif}UndefDirective);
|
||||
Add('INCLUDE',{$ifdef FPC}@{$endif}IncludeDirective);
|
||||
@ -1972,6 +1976,8 @@ begin
|
||||
Add('IFOPT',{$ifdef FPC}@{$endif}SkipIfDirective);
|
||||
Add('ENDIF',{$ifdef FPC}@{$endif}EndIfDirective);
|
||||
Add('ELSE',{$ifdef FPC}@{$endif}ElseDirective);
|
||||
Add('ELSEIF',{$ifdef FPC}@{$endif}ElseIfDirective);
|
||||
Add('IFEND',{$ifdef FPC}@{$endif}IfEndDirective);
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -1993,6 +1999,8 @@ begin
|
||||
// ignore link object directive
|
||||
else if (FDirectiveName='RANGECHECKS') then
|
||||
// ignore link object directive
|
||||
else if (FDirectiveName='ALIGN') then
|
||||
// set record align size
|
||||
else begin
|
||||
RaiseExceptionFmt(ctsInvalidFlagValueForDirective,
|
||||
[copy(Src,ValStart,SrcPos-ValStart),FDirectiveName]);
|
||||
@ -2121,13 +2129,14 @@ function TLinkScanner.EndifDirective: boolean;
|
||||
begin
|
||||
RaiseExceptionFmt(ctsAwithoutB,['$ENDIF','$IF'])
|
||||
end;
|
||||
|
||||
|
||||
begin
|
||||
dec(IfLevel);
|
||||
if IfLevel<0 then
|
||||
RaiseAWithoutB
|
||||
else if IfLevel<FSkipIfLevel then
|
||||
else if IfLevel<FSkipIfLevel then begin
|
||||
FSkippingTillEndif:=false;
|
||||
end;
|
||||
Result:=true;
|
||||
end;
|
||||
|
||||
@ -2149,6 +2158,42 @@ begin
|
||||
Result:=true;
|
||||
end;
|
||||
|
||||
function TLinkScanner.ElseIfDirective: boolean;
|
||||
// {$elseif expression}
|
||||
|
||||
procedure RaiseAWithoutB;
|
||||
begin
|
||||
RaiseExceptionFmt(ctsAwithoutB,['$ELSEIF','$IF']);
|
||||
end;
|
||||
|
||||
begin
|
||||
if IfLevel=0 then
|
||||
RaiseAWithoutB;
|
||||
if not FSkippingTillEndif then begin
|
||||
SkipTillEndifElse;
|
||||
Result:=true;
|
||||
end else if IfLevel=FSkipIfLevel then
|
||||
Result:=IfDirective;
|
||||
end;
|
||||
|
||||
function TLinkScanner.IfEndDirective: boolean;
|
||||
// {$IfEnd comment}
|
||||
|
||||
procedure RaiseAWithoutB;
|
||||
begin
|
||||
RaiseExceptionFmt(ctsAwithoutB,['$IfEnd','$ElseIf'])
|
||||
end;
|
||||
|
||||
begin
|
||||
dec(IfLevel);
|
||||
if IfLevel<0 then
|
||||
RaiseAWithoutB
|
||||
else if IfLevel<FSkipIfLevel then begin
|
||||
FSkippingTillEndif:=false;
|
||||
end;
|
||||
Result:=true;
|
||||
end;
|
||||
|
||||
function TLinkScanner.DefineDirective: boolean;
|
||||
// {$define name} or {$define name:=value}
|
||||
var VariableName: string;
|
||||
@ -2391,19 +2436,18 @@ begin
|
||||
end;
|
||||
|
||||
function TLinkScanner.IfDirective: boolean;
|
||||
// {$if expression}
|
||||
// {$if expression} or indirectly called by {$elseif expression}
|
||||
var Expr, ResultStr: string;
|
||||
begin
|
||||
inc(IfLevel);
|
||||
inc(SrcPos);
|
||||
Expr:=UpperCaseStr(copy(Src,SrcPos,CommentInnerEndPos-SrcPos));
|
||||
ResultStr:=Values.Eval(Expr);
|
||||
Result:=true;
|
||||
if Values.ErrorPosition>=0 then
|
||||
RaiseException(ctsErrorInDirectiveExpression)
|
||||
else if ResultStr='0' then
|
||||
SkipTillEndifElse
|
||||
else
|
||||
Result:=true;
|
||||
end;
|
||||
|
||||
function TLinkScanner.IfOptDirective: boolean;
|
||||
@ -2558,7 +2602,7 @@ begin
|
||||
OldDirectiveFuncList:=FDirectiveFuncList;
|
||||
FDirectiveFuncList:=FSkipDirectiveFuncList;
|
||||
try
|
||||
// parse till $else or $endif without adding the code to FCleanedSrc
|
||||
// parse till $else, $elseif or $endif without adding the code to FCleanedSrc
|
||||
FSkippingTillEndif:=true;
|
||||
FSkipIfLevel:=IfLevel;
|
||||
if (SrcPos<=SrcLen) then begin
|
||||
|
||||
@ -126,6 +126,9 @@ type
|
||||
InsertDelphi6CompilerDefinesTemplateMenuItem: TMenuItem;
|
||||
InsertDelphi6DirectoryTemplateMenuItem: TMenuItem;
|
||||
InsertDelphi6ProjectTemplateMenuItem: TMenuItem;
|
||||
InsertKylix3CompilerDefinesTemplateMenuItem: TMenuItem;
|
||||
InsertKylix3DirectoryTemplateMenuItem: TMenuItem;
|
||||
InsertKylix3ProjectTemplateMenuItem: TMenuItem;
|
||||
|
||||
// define tree
|
||||
DefineTreeView: TTreeView;
|
||||
@ -188,6 +191,9 @@ type
|
||||
procedure InsertDelphiCompilerDefinesTemplateMenuItemClick(Sender: TObject);
|
||||
procedure InsertDelphiDirectoryTemplateMenuItemClick(Sender: TObject);
|
||||
procedure InsertDelphiProjectTemplateMenuItemClick(Sender: TObject);
|
||||
procedure InsertKylixCompilerDefinesTemplateMenuItemClick(Sender: TObject);
|
||||
procedure InsertKylixDirectoryTemplateMenuItemClick(Sender: TObject);
|
||||
procedure InsertKylixProjectTemplateMenuItemClick(Sender: TObject);
|
||||
private
|
||||
FDefineTree: TDefineTree;
|
||||
FLastSelectedNode: TTreeNode;
|
||||
@ -909,6 +915,99 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCodeToolsDefinesEditor.InsertKylixCompilerDefinesTemplateMenuItemClick
|
||||
(Sender: TObject);
|
||||
var KylixVersion: integer;
|
||||
begin
|
||||
KylixVersion:=3;
|
||||
InsertTemplate(Boss.DefinePool.CreateKylixCompilerDefinesTemplate(
|
||||
KylixVersion,CodeToolsOpts));
|
||||
end;
|
||||
|
||||
procedure TCodeToolsDefinesEditor.InsertKylixDirectoryTemplateMenuItemClick(
|
||||
Sender: TObject);
|
||||
var
|
||||
InputFileDlg: TInputFileDialog;
|
||||
DirTemplate: TDefineTemplate;
|
||||
KylixVersion: integer;
|
||||
KylixName: string;
|
||||
UserName: String;
|
||||
begin
|
||||
KylixVersion:=3;
|
||||
KylixName:='Kylix'+IntToStr(KylixVersion);
|
||||
|
||||
UserName:=GetCurrentUserName;
|
||||
if UserName='' then UserName:='user';
|
||||
InputFileDlg:=GetInputFileDialog;
|
||||
InputFileDlg.Macros:=Macros;
|
||||
with InputFileDlg do begin
|
||||
BeginUpdate;
|
||||
Caption:=Format(lisCodeToolsDefsCreateDefinesForDirectory, [KylixName]);
|
||||
FileCount:=1;
|
||||
|
||||
FileTitles[0]:=Format(lisCodeToolsDefsdirectory, [KylixName]);
|
||||
FileDescs[0]:=Format(lisCodeToolsDefsKylixMainDirectoryDesc, [KylixName,
|
||||
#13, KylixName, #13, IntToStr(KylixVersion)]);
|
||||
FileNames[0]:=SetDirSeparators(
|
||||
'/home/'+UserName+'/kylix'+IntToStr(KylixVersion));
|
||||
FileFlags[0]:=[iftDirectory,iftNotEmpty,iftMustExist];
|
||||
|
||||
EndUpdate;
|
||||
if ShowModal=mrCancel then exit;
|
||||
DirTemplate:=Boss.DefinePool.CreateKylixDirectoryTemplate(FileNames[0],
|
||||
KylixVersion,CodeToolsOpts);
|
||||
if DirTemplate=nil then exit;
|
||||
DirTemplate.Name:=KylixName+' ('+FileNames[0]+')';
|
||||
InsertTemplate(DirTemplate);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCodeToolsDefinesEditor.InsertKylixProjectTemplateMenuItemClick(
|
||||
Sender: TObject);
|
||||
var
|
||||
InputFileDlg: TInputFileDialog;
|
||||
ProjTemplate: TDefineTemplate;
|
||||
KylixVersion: integer;
|
||||
KylixName: string;
|
||||
UserName: String;
|
||||
begin
|
||||
KylixVersion:=3;
|
||||
KylixName:='Kylix'+IntToStr(KylixVersion);
|
||||
|
||||
UserName:=GetCurrentUserName;
|
||||
if UserName='' then UserName:='user';
|
||||
InputFileDlg:=GetInputFileDialog;
|
||||
InputFileDlg.Macros:=Macros;
|
||||
with InputFileDlg do begin
|
||||
BeginUpdate;
|
||||
Caption:=Format(lisCodeToolsDefsCreateDefinesForProject, [KylixName]);
|
||||
|
||||
FileCount:=2;
|
||||
|
||||
FileTitles[0]:=Format(lisCodeToolsDefsprojectDirectory2, [KylixName]);
|
||||
FileDescs[0]:=Format(lisCodeToolsDefsTheProjectDirectory, [KylixName, #13]
|
||||
);
|
||||
FileNames[0]:=SetDirSeparators('/home/'+UserName+'/kylix'
|
||||
+IntToStr(KylixVersion)+'/YourProject');
|
||||
FileFlags[0]:=[iftDirectory,iftNotEmpty,iftMustExist];
|
||||
|
||||
FileTitles[1]:=Format(lisCodeToolsDefsdirectory, [KylixName]);
|
||||
FileDescs[1]:=Format(lisCodeToolsDefsKylixMainDirectoryForProject, [
|
||||
KylixName, #13, KylixName, #13, KylixName, #13, IntToStr(KylixVersion)
|
||||
]);
|
||||
FileNames[1]:=SetDirSeparators('/home/'+UserName+'/kylix'+IntToStr(KylixVersion));
|
||||
FileFlags[1]:=[iftDirectory,iftNotEmpty,iftMustExist];
|
||||
|
||||
EndUpdate;
|
||||
if ShowModal=mrCancel then exit;
|
||||
ProjTemplate:=Boss.DefinePool.CreateDelphiProjectTemplate(FileNames[0],
|
||||
FileNames[1],KylixVersion,CodeToolsOpts);
|
||||
if ProjTemplate=nil then exit;
|
||||
ProjTemplate.Name:=KylixName+' Project ('+FileNames[0]+')';
|
||||
InsertTemplate(ProjTemplate);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCodeToolsDefinesEditor.ValueNoteBookResize(Sender: TObject);
|
||||
var ValNoteBookMaxX, ValNoteBookMaxY: integer;
|
||||
begin
|
||||
@ -1225,7 +1324,8 @@ begin
|
||||
// templates
|
||||
AddMenuItem(InsertTemplateMenuItem,'InsertTemplateMenuItem',
|
||||
lisCodeToolsDefsInsertTemplate, nil);
|
||||
|
||||
|
||||
// FPC templates
|
||||
AddMenuItem(InsertFPCProjectDefinesTemplateMenuItem,
|
||||
'InsertFPCProjectDefinesTemplateMenuItem',
|
||||
lisCodeToolsDefsInsertFreePascalProjectTe,
|
||||
@ -1246,7 +1346,8 @@ begin
|
||||
InsertTemplateMenuItem);
|
||||
InsertFPCSourceDirTemplateMenuItem.OnClick:=
|
||||
@InsertFPCSourceDirDefinesTemplateMenuItemClick;
|
||||
|
||||
|
||||
// lazarus templates
|
||||
InsertTemplateMenuItem.Add(CreateSeperator);
|
||||
AddMenuItem(InsertLazarusSourceTemplateMenuItem,
|
||||
'InsertLazarusSourceTemplateMenuItem',
|
||||
@ -1255,6 +1356,7 @@ begin
|
||||
InsertLazarusSourceTemplateMenuItem.OnClick:=
|
||||
@InsertLazarusSourceDefinesTemplateMenuItemClick;
|
||||
|
||||
// Delphi 5 templates
|
||||
InsertTemplateMenuItem.Add(CreateSeperator);
|
||||
AddMenuItem(InsertDelphi5CompilerDefinesTemplateMenuItem,
|
||||
'InsertDelphi5CompilerDefinesTemplateMenuItem',
|
||||
@ -1277,7 +1379,7 @@ begin
|
||||
InsertDelphi5ProjectTemplateMenuItem.OnClick:=
|
||||
@InsertDelphiProjectTemplateMenuItemClick;
|
||||
|
||||
|
||||
// Delphi 6 templates
|
||||
InsertTemplateMenuItem.Add(CreateSeperator);
|
||||
AddMenuItem(InsertDelphi6CompilerDefinesTemplateMenuItem,
|
||||
'InsertDelphi6CompilerDefinesTemplateMenuItem',
|
||||
@ -1300,6 +1402,29 @@ begin
|
||||
InsertDelphi6ProjectTemplateMenuItem.OnClick:=
|
||||
@InsertDelphiProjectTemplateMenuItemClick;
|
||||
|
||||
// Kylix 3 templates
|
||||
InsertTemplateMenuItem.Add(CreateSeperator);
|
||||
AddMenuItem(InsertKylix3CompilerDefinesTemplateMenuItem,
|
||||
'InsertKylix3CompilerDefinesTemplateMenuItem',
|
||||
lisCodeToolsDefsInsertKylix3CompilerTemp,
|
||||
InsertTemplateMenuItem);
|
||||
InsertKylix3CompilerDefinesTemplateMenuItem.OnClick:=
|
||||
@InsertKylixCompilerDefinesTemplateMenuItemClick;
|
||||
|
||||
AddMenuItem(InsertKylix3DirectoryTemplateMenuItem,
|
||||
'InsertKylix3DirectoryTemplateMenuItem',
|
||||
lisCodeToolsDefsInsertKylix3DirectoryTem,
|
||||
InsertTemplateMenuItem);
|
||||
InsertKylix3DirectoryTemplateMenuItem.OnClick:=
|
||||
@InsertKylixDirectoryTemplateMenuItemClick;
|
||||
|
||||
AddMenuItem(InsertKylix3ProjectTemplateMenuItem,
|
||||
'InsertKylix3ProjectTemplateMenuItem',
|
||||
lisCodeToolsDefsInsertKylix3ProjectTempl,
|
||||
InsertTemplateMenuItem);
|
||||
InsertKylix3ProjectTemplateMenuItem.OnClick:=
|
||||
@InsertKylixProjectTemplateMenuItemClick;
|
||||
|
||||
// define tree----------------------------------------------------------------
|
||||
CreateWinControl(DefineTreeView,TTreeView,'DefineTreeView',Self);
|
||||
with DefineTreeView do begin
|
||||
|
||||
@ -1354,6 +1354,8 @@ resourcestring
|
||||
lisCodeToolsDefsDelphiMainDirectoryDesc = 'The %s main directory,%swhere '
|
||||
+'Borland has installed all %s sources.%sFor example: C:/Programme/'
|
||||
+'Borland/Delphi%s';
|
||||
lisCodeToolsDefsKylixMainDirectoryDesc = 'The %s main directory,%swhere '
|
||||
+'Borland has installed all %s sources.%sFor example: /home/user/kylix%s';
|
||||
lisCodeToolsDefsCreateDefinesForProject = 'Create Defines for %s Project';
|
||||
lisCodeToolsDefsprojectDirectory2 = '%s project directory';
|
||||
lisCodeToolsDefsTheProjectDirectory = 'The %s project directory,%swhich '
|
||||
@ -1361,6 +1363,9 @@ resourcestring
|
||||
lisCodeToolsDefsDelphiMainDirectoryForProject = 'The %s main directory,%'
|
||||
+'swhere Borland has installed all %s sources,%swhich are used by this %s '
|
||||
+'project.%sFor example: C:/Programme/Borland/Delphi%s';
|
||||
lisCodeToolsDefsKylixMainDirectoryForProject = 'The %s main directory,%'
|
||||
+'swhere Borland has installed all %s sources,%swhich are used by this %s '
|
||||
+'project.%sFor example: /home/user/kylix%s';
|
||||
lisCodeToolsDefsExit = 'Exit';
|
||||
lisCodeToolsDefsSaveAndExit = 'Save and Exit';
|
||||
lisCodeToolsDefsExitWithoutSave = 'Exit without Save';
|
||||
@ -1408,6 +1413,12 @@ resourcestring
|
||||
+'Template';
|
||||
lisCodeToolsDefsInsertDelphi6ProjectTempl =
|
||||
'Insert Delphi 6 Project Template';
|
||||
lisCodeToolsDefsInsertKylix3CompilerTemp = 'Insert Kylix 3 Compiler '
|
||||
+'Template';
|
||||
lisCodeToolsDefsInsertKylix3DirectoryTem = 'Insert Kylix 3 Directory '
|
||||
+'Template';
|
||||
lisCodeToolsDefsInsertKylix3ProjectTempl =
|
||||
'Insert Kylix 3 Project Template';
|
||||
lisCodeToolsDefsSelectedNode = 'Selected Node:';
|
||||
lisCodeToolsDefsNodeAndItsChildrenAreOnly = 'Node and its children are only '
|
||||
+'valid for this project';
|
||||
|
||||
@ -130,13 +130,6 @@ interface
|
||||
uses
|
||||
Classes, SysUtils, LCLType, LCLLinux, GraphType, Graphics;
|
||||
|
||||
type
|
||||
TClipboardData = record
|
||||
FormatID: TClipboardFormat;
|
||||
Stream: TMemoryStream;
|
||||
end;
|
||||
|
||||
|
||||
{ for delphi compatibility:
|
||||
|
||||
In Delphi there are 4 predefined constants, but the LCL has only dynamic
|
||||
@ -157,6 +150,11 @@ function CF_Component: TClipboardFormat;
|
||||
|
||||
|
||||
type
|
||||
TClipboardData = record
|
||||
FormatID: TClipboardFormat;
|
||||
Stream: TMemoryStream;
|
||||
end;
|
||||
|
||||
TClipboard = Class(TPersistent)
|
||||
private
|
||||
FAllocated: Boolean; // = has ownership
|
||||
@ -346,6 +344,9 @@ end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.12 2003/09/10 16:29:13 mattias
|
||||
added Kylix 3 specials
|
||||
|
||||
Revision 1.11 2003/06/17 15:57:27 mattias
|
||||
made compiler options TargetOS more general
|
||||
|
||||
|
||||
@ -32,14 +32,14 @@ end;
|
||||
|
||||
constructor TClipboard.Create(AClipboardType: TClipboardType);
|
||||
begin
|
||||
//writeln('[TClipboard.Create] A ',ClipboardTypeName[AClipboardType],' Self=',HexStr(Cardinal(Self),8));
|
||||
//writeln('[TClipboard.Create] A ',ClipboardTypeName[AClipboardType],' Self=',HexStr(Cardinal(Self),8));
|
||||
inherited Create;
|
||||
FClipboardType:=AClipboardType;
|
||||
end;
|
||||
|
||||
destructor TClipboard.Destroy;
|
||||
begin
|
||||
//writeln('[TClipboard.Destroy] A ',ClipboardTypeName[ClipboardType],' Self=',HexStr(Cardinal(Self),8));
|
||||
//writeln('[TClipboard.Destroy] A ',ClipboardTypeName[ClipboardType],' Self=',HexStr(Cardinal(Self),8));
|
||||
OnRequest:=nil; // this will notify the owner
|
||||
if FAllocated then begin
|
||||
ClipboardGetOwnership(ClipboardType,nil,0,nil);
|
||||
@ -47,7 +47,7 @@ begin
|
||||
end;
|
||||
Clear;
|
||||
inherited Destroy;
|
||||
//writeln('[TClipboard.Destroy] END ',ClipboardTypeName[ClipboardType]);
|
||||
//writeln('[TClipboard.Destroy] END ',ClipboardTypeName[ClipboardType]);
|
||||
end;
|
||||
|
||||
function TClipboard.IndexOfCachedFormatID(FormatID: TClipboardFormat;
|
||||
@ -91,7 +91,7 @@ function TClipboard.AddFormat(FormatID: TClipboardFormat;
|
||||
// copy Stream to a MemoryStream, add it to cache and tell the interface object
|
||||
var OldPosition, i: integer;
|
||||
begin
|
||||
//writeln('[TClipboard.AddFormat - Stream] A ',ClipboardTypeName[ClipboardType],' Format=',FormatID);
|
||||
//writeln('[TClipboard.AddFormat - Stream] A ',ClipboardTypeName[ClipboardType],' Format=',FormatID);
|
||||
Result:=false;
|
||||
i:=IndexOfCachedFormatID(FormatID,true);
|
||||
if i<0 then exit;
|
||||
@ -110,7 +110,7 @@ function TClipboard.AddFormat(FormatID: TClipboardFormat;
|
||||
var Buffer; Size: Integer): Boolean;
|
||||
var i: integer;
|
||||
begin
|
||||
//writeln('[TClipboard.AddFormat - Buffer] A ',ClipboardTypeName[ClipboardType],' Format=',FormatID,' Size=',Size);
|
||||
//writeln('[TClipboard.AddFormat - Buffer] A ',ClipboardTypeName[ClipboardType],' Format=',FormatID,' Size=',Size);
|
||||
Result:=false;
|
||||
i:=IndexOfCachedFormatID(FormatID,true);
|
||||
if i<0 then exit;
|
||||
@ -130,7 +130,7 @@ end;
|
||||
procedure TClipboard.Clear;
|
||||
var i: integer;
|
||||
begin
|
||||
//writeln('[TClipboard.Clear] A ',ClipboardTypeName[ClipboardType]);
|
||||
//writeln('[TClipboard.Clear] A ',ClipboardTypeName[ClipboardType]);
|
||||
for i:=0 to FCount-1 do
|
||||
FData[i].Stream.Free;
|
||||
if FData<>nil then begin
|
||||
@ -138,7 +138,7 @@ begin
|
||||
FData:=nil;
|
||||
end;
|
||||
FCount:=0;
|
||||
//writeln('[TClipboard.Clear] END ',ClipboardTypeName[ClipboardType]);
|
||||
//writeln('[TClipboard.Clear] END ',ClipboardTypeName[ClipboardType]);
|
||||
end;
|
||||
|
||||
{procedure TClipboard.Adding;
|
||||
@ -153,33 +153,15 @@ procedure TClipboard.Close;
|
||||
begin
|
||||
if FOpenRefCount = 0 then Exit;
|
||||
Dec(FOpenRefCount);
|
||||
{
|
||||
if FOpenRefCount = 0 then
|
||||
begin
|
||||
CloseClipboard;
|
||||
if FAllocated then DeallocateHWnd(FClipboardWindow);
|
||||
FClipboardWindow := 0;
|
||||
if FOpenRefCount = 0 then begin
|
||||
end;
|
||||
}
|
||||
end;
|
||||
|
||||
procedure TClipboard.Open;
|
||||
begin
|
||||
if FOpenRefCount = 0 then
|
||||
begin
|
||||
if FOpenRefCount = 0 then begin
|
||||
if not GetOwnerShip then
|
||||
raise Exception.Create('unable to open clipboard');
|
||||
{
|
||||
FClipboardWindow := Application.Handle;
|
||||
if FClipboardWindow = 0 then
|
||||
begin
|
||||
FClipboardWindow := AllocateHWnd(WndProc);
|
||||
FAllocated := True;
|
||||
end;
|
||||
if not OpenClipboard(FClipboardWindow) then
|
||||
raise Exception.CreateRes(@SCannotOpenClipboard);
|
||||
FEmptied := False;
|
||||
}
|
||||
end;
|
||||
Inc(FOpenRefCount);
|
||||
end;
|
||||
@ -232,7 +214,7 @@ function TClipboard.GetFormat(FormatID: TClipboardFormat;
|
||||
// request data from interface object or copy cached data to Stream
|
||||
var i: integer;
|
||||
begin
|
||||
//writeln('[TClipboard.GetFormat] A ',ClipboardTypeName[ClipboardType],' FormatID=',FormatID,' ',ClipboardFormatToMimeType(FormatID),' Allocated=',fAllocated);
|
||||
//writeln('[TClipboard.GetFormat] A ',ClipboardTypeName[ClipboardType],' FormatID=',FormatID,' ',ClipboardFormatToMimeType(FormatID),' Allocated=',fAllocated);
|
||||
Result:=false;
|
||||
if Stream=nil then exit;
|
||||
if FormatID=0 then exit;
|
||||
@ -255,7 +237,7 @@ begin
|
||||
// not the clipboard owner -> request data
|
||||
Result:=ClipboardGetData(ClipboardType,FormatID,Stream);
|
||||
end;
|
||||
//writeln('[TClipboard.GetFormat] END ',ClipboardTypeName[ClipboardType],' FormatID=',FormatID,' Result=',Result);
|
||||
//writeln('[TClipboard.GetFormat] END ',ClipboardTypeName[ClipboardType],' FormatID=',FormatID,' Result=',Result);
|
||||
end;
|
||||
|
||||
procedure TClipboard.SetComponent(Component: TComponent);
|
||||
@ -379,6 +361,7 @@ begin
|
||||
for i:=0 to FCount-1 do
|
||||
List.Add(ClipboardFormatToMimeType(FData[i].FormatID));
|
||||
end else begin
|
||||
FormatList:=nil;
|
||||
if ClipboardGetFormats(ClipboardType,cnt,FormatList) then begin
|
||||
for i:=0 to cnt-1 do
|
||||
List.Add(ClipboardFormatToMimeType(FormatList[i]));
|
||||
@ -428,27 +411,31 @@ const
|
||||
pcfPicture,
|
||||
pcfDelphiBitmap,
|
||||
pcfDelphiPicture,
|
||||
//pcfDelphiMetaFilePict, (unsupportted yet)
|
||||
//pcfDelphiMetaFilePict, (unsupported yet)
|
||||
pcfKylixPicture,
|
||||
pcfKylixBitmap
|
||||
//pcfKylixDrawing (unsupportted yet)
|
||||
//pcfKylixDrawing (unsupported yet)
|
||||
];
|
||||
var f: TPredefinedClipboardFormat;
|
||||
var
|
||||
f: TPredefinedClipboardFormat;
|
||||
List: PClipboardFormat;
|
||||
cnt, i: integer;
|
||||
begin
|
||||
//writeln('[TClipboard.FindPictureFormatID]');
|
||||
//writeln('[TClipboard.FindPictureFormatID]');
|
||||
List:=nil;
|
||||
if not FAllocated then
|
||||
ClipboardGetFormats(ClipboardType,cnt,List)
|
||||
if not ClipboardGetFormats(ClipboardType,cnt,List) then begin
|
||||
Result:=0;
|
||||
exit;
|
||||
end;
|
||||
else begin
|
||||
cnt:=0;
|
||||
List:=nil;
|
||||
end;
|
||||
try
|
||||
for f:=Low(TPredefinedClipboardFormat) to High(TPredefinedClipboardFormat) do
|
||||
begin
|
||||
Result:=PredefinedClipboardFormat(f);
|
||||
if (f in PicFormats) and (Result<>0) then begin
|
||||
if (Result<>0) and (f in PicFormats) then begin
|
||||
if not FAllocated then begin
|
||||
for i:=0 to cnt-1 do
|
||||
if (List[i]=Result) then exit;
|
||||
@ -473,15 +460,18 @@ function TClipboard.HasFormat(FormatID: TClipboardFormat): Boolean;
|
||||
var List: PClipboardFormat;
|
||||
cnt, i: integer;
|
||||
begin
|
||||
//writeln('[TClipboard.HasFormat] A ',ClipboardTypeName[ClipboardType],' Allocated=',FAllocated);
|
||||
//writeln('[TClipboard.HasFormat] A ',ClipboardTypeName[ClipboardType],' Allocated=',FAllocated);
|
||||
if FormatID<>0 then begin
|
||||
if FAllocated then
|
||||
Result := (IndexOfCachedFormatID(FormatID,false)>=0)
|
||||
else begin
|
||||
ClipboardGetFormats(ClipboardType,cnt,List);
|
||||
if not ClipboardGetFormats(ClipboardType,cnt,List) then begin
|
||||
Result:=false;
|
||||
exit;
|
||||
end;
|
||||
i:=0;
|
||||
//for i:=0 to cnt-1 do
|
||||
//writeln('[TClipboard.HasFormat] ',FormatID,' ',List[i]);
|
||||
//for i:=0 to cnt-1 do
|
||||
//writeln('[TClipboard.HasFormat] ',FormatID,' ',List[i]);
|
||||
while (i<cnt) and (List[i]<>FormatID) do inc(i);
|
||||
Result := i<cnt;
|
||||
if List<>nil then FreeMem(List);
|
||||
@ -494,7 +484,7 @@ begin
|
||||
end;
|
||||
end else
|
||||
Result:=false;
|
||||
//writeln('[TClipboard.HasFormat] END ',ClipboardTypeName[ClipboardType],' FormatID=',FormatID,' Result=',Result);
|
||||
//writeln('[TClipboard.HasFormat] END ',ClipboardTypeName[ClipboardType],' FormatID=',FormatID,' Result=',Result);
|
||||
end;
|
||||
|
||||
procedure TClipboard.AssignToPicture(Dest: TPicture);
|
||||
@ -539,7 +529,8 @@ begin
|
||||
AssignPicture(TPicture(Source))
|
||||
else if Source is TGraphic then
|
||||
AssignGraphic(TGraphic(Source))
|
||||
else inherited Assign(Source);
|
||||
else
|
||||
inherited Assign(Source);
|
||||
end;
|
||||
|
||||
procedure TClipboard.AssignTo(Dest: TPersistent);
|
||||
@ -550,7 +541,8 @@ begin
|
||||
AssignToBitmap(TBitmap(Dest))
|
||||
else if Dest is TPixmap then
|
||||
AssignToPixmap(TPixmap(Dest))
|
||||
else inherited AssignTo(Dest);
|
||||
else
|
||||
inherited AssignTo(Dest);
|
||||
end;
|
||||
|
||||
{function TClipboard.GetAsHandle(Format: Word): THandle;
|
||||
@ -578,38 +570,46 @@ function TClipboard.GetFormatCount: Integer;
|
||||
// ask interfaceobject
|
||||
var List: PClipboardFormat;
|
||||
begin
|
||||
//writeln('[TClipboard.GetFormatCount]');
|
||||
//writeln('[TClipboard.GetFormatCount]');
|
||||
if FAllocated then
|
||||
Result:=FCount
|
||||
else begin
|
||||
ClipboardGetFormats(ClipboardType,Result,List);
|
||||
if List<>nil then FreeMem(List);
|
||||
if ClipboardGetFormats(ClipboardType,Result,List) then begin
|
||||
if List<>nil then FreeMem(List);
|
||||
end else
|
||||
Result:=0;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TClipboard.GetFormats(Index: Integer): TClipboardFormat;
|
||||
var List: PClipboardFormat;
|
||||
var
|
||||
List: PClipboardFormat;
|
||||
cnt: integer;
|
||||
begin
|
||||
//writeln('[TClipboard.GetFormats] Index=',Index);
|
||||
//writeln('[TClipboard.GetFormats] Index=',Index);
|
||||
if FAllocated then begin
|
||||
if (Index<0) or (Index>=FCount) then
|
||||
raise Exception.Create('TClipboard.GetFormats: Index out of bounds: Index='
|
||||
+IntToStr(Index)+' Count='+IntToStr(FCount));
|
||||
Result:=FData[Index].FormatID;
|
||||
end else begin
|
||||
ClipboardGetFormats(ClipboardType,cnt,List);
|
||||
if (Index>=0) and (Index<cnt) then
|
||||
Result:=List[Index]
|
||||
else
|
||||
if ClipboardGetFormats(ClipboardType,cnt,List) then begin
|
||||
if (Index>=0) and (Index<cnt) then
|
||||
Result:=List[Index]
|
||||
else
|
||||
Result:=0;
|
||||
if List<>nil then FreeMem(List);
|
||||
end else
|
||||
Result:=0;
|
||||
if List<>nil then FreeMem(List);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.12 2003/09/10 16:29:13 mattias
|
||||
added Kylix 3 specials
|
||||
|
||||
Revision 1.11 2003/01/06 10:51:41 mattias
|
||||
freeing stopped external tools
|
||||
|
||||
|
||||
@ -1699,7 +1699,7 @@ type
|
||||
pcfComponent,
|
||||
pcfCustomData,
|
||||
|
||||
// Delphi definitions (only for compatibility)
|
||||
// Delphi definitions (only for compatibility)
|
||||
pcfDelphiText,
|
||||
pcfDelphiBitmap,
|
||||
pcfDelphiPicture,
|
||||
@ -1707,7 +1707,7 @@ type
|
||||
pcfDelphiObject,
|
||||
pcfDelphiComponent,
|
||||
|
||||
// Kylix definitions (only for compatibility)
|
||||
// Kylix definitions (only for compatibility)
|
||||
pcfKylixPicture,
|
||||
pcfKylixBitmap,
|
||||
pcfKylixDrawing,
|
||||
@ -1813,6 +1813,9 @@ end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.41 2003/09/10 16:29:13 mattias
|
||||
added Kylix 3 specials
|
||||
|
||||
Revision 1.40 2003/07/07 07:59:34 mattias
|
||||
made Size_SourceIsInterface a flag
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user