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

git-svn-id: trunk@3733 -

components/codetools/customcodetool.pas

@@ -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);

components/codetools/keywordfunclists.pas

@@ -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);

components/codetools/pascalparsertool.pas

@@ -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

lcl/forms.pp

@@ -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;

lcl/include/customform.inc

@@ -843,42 +843,40 @@ Procedure TCustomForm.Close;
 var
   CloseAction: TCloseAction;
 begin
-  Assert(False, Format('Trace:[TCustomForm.Close] %s', [ClassName]));
+  if fsModal in FFormState then
-  CloseAction := caHide;
+    ModalResult := mrCancel
-  DoClose(CloseAction);
+  else begin
-  if CloseAction <> caNone 
+    if CloseQuery then
-  then begin
+    begin
-    if Application.MainForm = Self 
+      if FormStyle = fsMDIChild then begin
-    then Application.Terminate
+        //if biMinimize in BorderIcons then
-    else begin
+        //  CloseAction := caMinimize
-      case CloseAction of
+        //else
-        caHide : 
+          CloseAction := caNone;
-          begin
+      end else begin
-        	  if Visible 
+        CloseAction := caHide;
-        	  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;
       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
 

lcl/lcltype.pp

@@ -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