paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-16 23:49:28 +02:00
Code Issues Packages Projects Releases Wiki Activity

made Form.Close more Delphish, added some windows compatibility functions

Browse Source 
git-svn-id: trunk@3733 -
This commit is contained in:
mattias 2002-12-25 10:21:05 +00:00
parent eb74c0b02d
commit 17f2aeb9bc
6 changed files with 131 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
components/codetools/customcodetool.pas
View File

@ -82,6 +82,7 @@ type
protected
FIgnoreErrorAfter: TCodePosition;
KeyWordFuncList: TKeyWordFunctionList;
WordIsKeyWordFuncList: TKeyWordFunctionList;
FForceUpdateNeeded: boolean;
function DefaultKeyWordFunc: boolean;
procedure BuildDefaultKeyWordFunctions; virtual;
@ -246,6 +247,7 @@ begin
Tree:=TCodeTree.Create;
KeyWordFuncList:=TKeyWordFunctionList.Create;
BuildDefaultKeyWordFunctions;
WordIsKeyWordFuncList:=WordIsKeyWord;
LastAtoms:=TAtomRing.Create;
IndentSize:=2;
VisibleEditorLines:=20;
@ -488,7 +490,7 @@ function TCustomCodeTool.AtomIsKeyWord: boolean;
begin
Result:=(CurPos.StartPos<=SrcLen)
and (IsIdentStartChar[UpperSrc[CurPos.StartPos]])
and (WordIsKeyWord.DoItUpperCase(UpperSrc,CurPos.StartPos,
and (WordIsKeyWordFuncList.DoItUpperCase(UpperSrc,CurPos.StartPos,
CurPos.EndPos-CurPos.StartPos));
end;
@ -502,7 +504,7 @@ function TCustomCodeTool.AtomIsIdentifier(ExceptionOnNotFound: boolean):boolean;
begin
if CurPos.StartPos<=SrcLen then begin
if IsIdentStartChar[UpperSrc[CurPos.StartPos]] then begin
if not WordIsKeyWord.DoItUpperCase(UpperSrc,CurPos.StartPos,
if not WordIsKeyWordFuncList.DoItUpperCase(UpperSrc,CurPos.StartPos,
CurPos.EndPos-CurPos.StartPos) then
Result:=true
else begin
@ -1521,7 +1523,7 @@ end;
function TCustomCodeTool.StringIsKeyWord(const Word: string): boolean;
begin
Result:=(Word<>'') and IsIdentStartChar[Word[1]]
and WordIsKeyWord.DoItUpperCase(Word,1,length(Word));
and WordIsKeyWordFuncList.DoItUpperCase(Word,1,length(Word));
end;
procedure TCustomCodeTool.MoveCursorToNodeStart(ANode: TCodeTreeNode);

70
components/codetools/keywordfunclists.pas
View File

@ -85,6 +85,7 @@ var
IsKeyWordSection,
IsKeyWordInConstAllowed,
WordIsKeyWord,
WordIsDelphiKeyWord,
IsKeyWordBuiltInFunc,
WordIsTermOperator,
WordIsPropertySpecifier,
@ -654,7 +655,74 @@ begin
Add('NOT',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('OBJECT',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('OF',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('OPERATOR',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('OPERATOR',{$ifdef FPC}@{$endif}AllwaysTrue); // not for Delphi
//Add('ON',{$ifdef FPC}@{$endif}AllwaysTrue); // not for Delphi
Add('OR',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('PACKED',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('PROCEDURE',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('PROGRAM',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('PROPERTY',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('RAISE',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('RECORD',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('RESOURCESTRING',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('REPEAT',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('SET',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('SHL',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('SHR',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('THEN',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('TO',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('TRY',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('TYPE',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('UNIT',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('UNTIL',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('USES',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('VAR',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('THREADVAR',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('WHILE',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('WITH',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('XOR',{$ifdef FPC}@{$endif}AllwaysTrue);
end;
WordIsDelphiKeyWord:=TKeyWordFunctionList.Create;
KeyWordLists.Add(WordIsDelphiKeyWord);
with WordIsDelphiKeyWord do begin
Add('AS',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('AND',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('ARRAY',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('ASM',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('BEGIN',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('CASE',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('CLASS',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('CONST',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('CONSTRUCTOR',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('DESTRUCTOR',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('DIV',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('DO',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('DOWNTO',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('ELSE',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('END',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('EXCEPT',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('EXPORTS',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('FINALIZATION',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('FINALLY',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('FOR',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('FUNCTION',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('GOTO',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('IF',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('IMPLEMENTATION',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('IN',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('INITIALIZATION',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('INHERITED',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('INLINE',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('INTERFACE',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('IS',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('LABEL',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('LIBRARY',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('MOD',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('NIL',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('NOT',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('OBJECT',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('OF',{$ifdef FPC}@{$endif}AllwaysTrue);
//Add('OPERATOR',{$ifdef FPC}@{$endif}AllwaysTrue); // not for Delphi
//Add('ON',{$ifdef FPC}@{$endif}AllwaysTrue); // not for Delphi
Add('OR',{$ifdef FPC}@{$endif}AllwaysTrue);
Add('PACKED',{$ifdef FPC}@{$endif}AllwaysTrue);

7
components/codetools/pascalparsertool.pas
View File

@ -482,6 +482,10 @@ begin
// parse code and build codetree
CurrentPhase:=CodeToolPhaseParse;
if Scanner.CompilerMode=cmDELPHI then
WordIsKeyWordFuncList:=WordIsDelphiKeyWord
else
WordIsKeyWordFuncList:=WordIsKeyWord;
InterfaceSectionFound:=false;
ImplementationSectionFound:=false;
@ -2393,8 +2397,9 @@ begin
CurNode.EndPos:=CurPos.EndPos;
ReadNextAtom;
end;
if (CurPos.Flag<>cafColon) then
if (CurPos.Flag<>cafColon) then begin
RaiseCharExpectedButAtomFound(':');
end;
// read type
ReadVariableType;
end else begin

1
lcl/forms.pp
View File

@ -330,6 +330,7 @@ type
function GetIconHandle: HICON;
destructor Destroy; override;
procedure Close;
procedure Release;
procedure Hide;
function WantChildKey(Child : TControl; var MEssage : TLMessage): Boolean; virtual;
procedure SetFocus; override;

67
lcl/include/customform.inc
View File

@ -843,42 +843,40 @@ Procedure TCustomForm.Close;
var
CloseAction: TCloseAction;
begin
Assert(False, Format('Trace:[TCustomForm.Close] %s', [ClassName]));
CloseAction := caHide;
DoClose(CloseAction);
if CloseAction <> caNone
then begin
if Application.MainForm = Self
then Application.Terminate
else begin
case CloseAction of
caHide :
begin
if Visible
then Assert(False, 'Trace:Performing Hide')
else Assert(False, 'Trace:They say it is not visible !!!');
end;
caMinimize :
begin
Assert(False, 'Trace:Performing minimize');
end;
else
Assert(False, 'Trace:Performing free');
end;
case CloseAction of
caHide: Hide;
caMinimize: WindowState := wsMinimized;
else
{Release =}Free;
if fsModal in FFormState then
ModalResult := mrCancel
else begin
if CloseQuery then
begin
if FormStyle = fsMDIChild then begin
//if biMinimize in BorderIcons then
// CloseAction := caMinimize
//else
CloseAction := caNone;
end else begin
CloseAction := caHide;
end;
end;
DoClose(CloseAction);
if CloseAction <> caNone then
if Application.MainForm = Self then Application.Terminate
else if CloseAction = caHide then Hide
else if CloseAction = caMinimize then WindowState := wsMinimized
else Release;
end;
end;
end;
{------------------------------------------------------------------------------}
{ TCustomForm Method CloseQuery }
{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------
procedure TCustomForm.Release;
------------------------------------------------------------------------------}
procedure TCustomForm.Release;
begin
Free;
end;
{------------------------------------------------------------------------------
TCustomForm Method CloseQuery
------------------------------------------------------------------------------}
function TCustomForm.CloseQuery : boolean;
//var i : integer;
begin
@ -893,8 +891,6 @@ begin
end;
Result:= true;
if Assigned(FOnCloseQuery) then FOnCloseQuery(Self, Result);
if Result then Assert(False, 'Trace:CloseQuery returns true')
else Assert(False, 'Trace:CloseQuery returns false');
end;
{------------------------------------------------------------------------------}
@ -1181,6 +1177,9 @@ end;
{ =============================================================================
$Log$
Revision 1.76 2002/12/25 10:21:05 mattias
made Form.Close more Delphish, added some windows compatibility functions
Revision 1.75 2002/12/03 17:40:37 mattias
fixed deleting lookup form when form is deleted

18
lcl/lcltype.pp
View File

@ -107,7 +107,7 @@ type
TKeyBoardState = array[0..255] of byte;
PABC = ^TABC;
PABC = ^TABC;
_ABC = packed record
abcA: Integer;
@ -1299,6 +1299,19 @@ const
LOGPIXELSY = 90;
{ Text Alignment Options }
TA_NOUPDATECP = 0;
TA_UPDATECP = 1;
TA_LEFT = 0;
TA_RIGHT = 2;
TA_CENTER = 6;
TA_TOP = 0;
TA_BOTTOM = 8;
TA_BASELINE = 24;
TA_RTLREADING = $100;
TA_MASK = (TA_BASELINE+TA_CENTER+TA_UPDATECP+TA_RTLREADING);
type
TFarProc = Pointer;
@ -1741,6 +1754,9 @@ end.
{
$Log$
Revision 1.29 2002/12/25 10:21:05 mattias
made Form.Close more Delphish, added some windows compatibility functions
Revision 1.28 2002/12/12 17:47:45 mattias
new constants for compatibility