* a lot of small changes:

     - setlength is internal
     - win32 graph unit extended
     ....

rtl/i386/math.inc

@@ -179,6 +179,36 @@
          end;
      end;
 
+{****************************************************************************
+                    Helper routines to support old TP styled reals
+ ****************************************************************************}
+
+    function real2double(r : real48) : double;
+
+      var
+         res : array[0..7] of byte;
+         exponent : word;
+
+      begin
+         { copy mantissa }
+         res[0]:=0;
+         res[1]:=r[1] shl 5;
+         res[2]:=(r[1] shr 3) or (r[2] shl 5);
+         res[3]:=(r[2] shr 3) or (r[3] shl 5);
+         res[4]:=(r[3] shr 3) or (r[4] shl 5);
+         res[5]:=(r[4] shr 3) or (r[5] and $7f) shl 5;
+         res[6]:=(r[5] and $7f) shr 3;
+
+         { copy exponent }
+         { correct exponent: }
+         exponent:=(word(r[0])+(1023-129));
+         res[6]:=res[6] or ((exponent and $f) shl 4);
+         res[7]:=exponent shr 4;
+
+         { set sign }
+         res[7]:=res[7] or (r[5] and $80);
+         real2double:=double(res);
+      end;
 
 {****************************************************************************
                          Fixed data type routines
@@ -299,10 +329,16 @@
 
 {
   $Log$
-  Revision 1.3  2000-07-14 10:33:10  michael
+  Revision 1.4  2000-10-21 18:20:17  florian
+    * a lot of small changes:
+       - setlength is internal
+       - win32 graph unit extended
+       ....
+
+  Revision 1.3  2000/07/14 10:33:10  michael
   + Conditionals fixed
 
   Revision 1.2  2000/07/13 11:33:41  michael
   + removed logs
- 
-}
+
+}

rtl/i386/rttip.inc

@@ -14,6 +14,8 @@
  **********************************************************************}
 
 { Run-Time type information routines - processor dependent part }
+{ I think we should use the pascal version, this code isn't     }
+{ much faster                                                   }
 
 Procedure Initialize (Data,TypeInfo : pointer);[Public,Alias:'FPC_INITIALIZE'];assembler;
 asm
@@ -30,17 +32,37 @@ asm
         jz      .LDoAnsiStringInit
         decb    %al
         jz      .LDoAnsiStringInit
-        subb    $2,%al
+        decb    %al
+        jz      .LDoVariantInit
+        decb    %al
         jz      .LDoArrayInit
         decb    %al
         jz      .LDoRecordInit
-        subb    $2,%al
+        decb    %al
+        jz      .LDoInterfaceInit
+        decb    %al
         jz      .LDoClassInit
         decb    %al
         jz      .LDoObjectInit
         decb    %al
+        // what is called here ??? FK
         jz      .LDoClassInit
+        subb    $4,%al
+        jz      .LDoDynArrayInit
         jmp     .LExitInitialize
+        // Interfaces
+.LDoInterfaceInit:
+        movl Data, %eax
+        movl $0,(%eax)
+        jmp     .LExitInitialize
+        // Variants
+.LDoVariantInit:
+        jmp     .LExitInitialize
+        // dynamic Array
+.LDoDynArrayInit:
+        movl Data, %eax
+        movl $0,(%eax)
+        jmp    .LExitInitialize
 .LDoObjectInit:
 .LDoClassInit:
 .LDoRecordInit:
@@ -122,17 +144,46 @@ asm
         jz      .LDoAnsiStringFinal
         decb    %al
         jz      .LDoAnsiStringFinal
-        subb    $2,%al
+        decb    %al
+        jz      .LDoVariantFinal
+        decb    %al
         jz      .LDoArrayFinal
         decb    %al
         jz      .LDoRecordFinal
-        subb    $2,%al
+        decb    %al
+        jz      .LDoInterfaceFinal
+        decb    %al
         jz      .LDoClassFinal
         decb    %al
         jz      .LDoObjectFinal
         decb    %al
+        // what is called here ??? FK
         jz      .LDoClassFinal
+        subb    $4,%al
+        jz      .LDoDynArrayFinal
+        jmp     .LExitFinalize
+        // Interfaces
+.LDoInterfaceFinal:
+        jmp     .LExitFinalize
+        // Variants
+.LDoVariantFinal:
         jmp     .LExitFinalize
+        // dynamic Array
+.LDoDynArrayFinal:
+// load count
+        movl    Data,%edx
+        orl     %edx,%edx
+        jz      .LExitFinalize
+        movl    -4(%edx),%edx
+        incl    %ebx
+        movzbl  (%ebx),%eax
+        incl    %eax
+        addl    %eax,%ebx
+// %ebx points to size. Put size in ecx
+        movl    (%ebx),%ecx
+// %ebx points to type. Put into ebx.
+        addl    $4, %ebx
+        jmp     .LMyArrayFinalLoop
 .LDoClassFinal:
 .LDoObjectFinal:
 .LDoRecordFinal:
@@ -215,16 +266,37 @@ asm
         jz      .LDoAnsiStringAddRef
         decb    %al
         jz      .LDoAnsiStringAddRef
-        subb    $2,%al
+        decb    %al
+        jz      .LDoVariantAddRef
+        decb    %al
         jz      .LDoArrayAddRef
         decb    %al
         jz      .LDoRecordAddRef
-        subb    $2,%al
+        decb    %al
+        jz      .LDoInterfaceAddRef
+        decb    %al
         jz      .LDoClassAddRef
         decb    %al
         jz      .LDoObjectAddRef
         decb    %al
+        // what is called here ??? FK
         jz      .LDoClassAddRef
+        subb    $4,%al
+        jz      .LDoDynArrayAddRef
+        jmp     .LExitAddRef
+        // Interfaces
+.LDoInterfaceAddRef:
+        jmp     .LExitAddRef
+        // Variants
+.LDoVariantAddRef:
+        jmp     .LExitAddRef
+        // Dynamic Arrays
+.LDoDynArrayAddRef:
+        movl    Data,%eax
+        testl   %eax,%eax
+        je      .LExitAddRef
+        lock
+        incl    -4(%eax)
         jmp     .LExitAddRef
 .LDoClassAddRef:
 .LDoObjectAddRef:
@@ -306,16 +378,32 @@ asm
         jz      .LDoAnsiStringDecRef
         decb    %al
         jz      .LDoAnsiStringDecRef
-        subb    $2,%al
+        decb    %al
+        jz      .LDoVariantDecRef
+        decb    %al
         jz      .LDoArrayDecRef
         decb    %al
         jz      .LDoRecordDecRef
-        subb    $2,%al
+        decb    %al
+        jz      .LDoInterfaceDecRef
+        decb    %al
         jz      .LDoClassDecRef
         decb    %al
         jz      .LDoObjectDecRef
         decb    %al
+        // what is called here ??? FK
         jz      .LDoClassDecRef
+        subb    $4,%al
+        jz      .LDoDynArrayDecRef
+        jmp     .LExitDecRef
+        // Interfaces
+.LDoInterfaceDecRef:
+        jmp     .LExitDecRef
+        // Variants
+.LDoVariantDecRef:
+        jmp     .LExitDecRef
+        // Dynamic Arrays
+.LDoDynArrayDecRef:
         jmp     .LExitDecRef
 .LDoClassDecRef:
 .LDoObjectDecRef:
@@ -385,7 +473,12 @@ end;
 
 {
   $Log$
-  Revision 1.2  2000-07-13 11:33:41  michael
+  Revision 1.3  2000-10-21 18:20:17  florian
+    * a lot of small changes:
+       - setlength is internal
+       - win32 graph unit extended
+       ....
+
+  Revision 1.2  2000/07/13 11:33:41  michael
   + removed logs
- 
-}
+}

rtl/inc/astrings.inc

@@ -344,52 +344,11 @@ begin
     HandleErrorFrame(201,get_frame);
 end;
 
-
-{$ifdef EXTRAANSISHORT}
-Function AnsiStr_ShortStr_Compare (Var S1 : Pointer; Var S2 : ShortString): Longint;
-{
-  Compares a AnsiString with a ShortString;
-  The result is
-   <0 if S1<S2
-   0 if S1=S2
-   >0 if S1>S2
-}
-Var
-  i,MaxI,Temp : Longint;
-begin
-  Temp:=0;
-  i:=0;
-  MaxI:=Length(AnsiString(S1));
-  if MaxI>byte(S2[0]) then
-    MaxI:=Byte(S2[0]);
-  While (i<MaxI) and (Temp=0) do
-   begin
-     Temp:= PByte(S1+I)^ - Byte(S2[i+1]);
-     inc(i);
-   end;
-  AnsiStr_ShortStr_Compare:=Temp;
-end;
-{$endif EXTRAANSISHORT}
-
-
-{*****************************************************************************
-                     Public functions, In interface.
-*****************************************************************************}
-
-Function Length (Const S : AnsiString) : Longint;
-{
-  Returns the length of an AnsiString.
-  Takes in acount that zero strings are NIL;
-}
-begin
-  If Pointer(S)=Nil then
-    Length:=0
-  else
-    Length:=PAnsiRec(Pointer(S)-FirstOff)^.Len;
-end;
-
-
+{$ifdef ver1_0}
 Procedure SetLength (Var S : AnsiString; l : Longint);
+{$else ver1_0}
+Procedure AnsiStr_SetLength (Var S : AnsiString; l : Longint);[Public,Alias : 'FPC_ANSISTR_SETLENGTH'];
+{$endif ver1_0}
 {
   Sets The length of string S to L.
   Makes sure S is unique, and contains enough room.
@@ -435,6 +394,49 @@ begin
     end;
 end;
 
+{$ifdef EXTRAANSISHORT}
+Function AnsiStr_ShortStr_Compare (Var S1 : Pointer; Var S2 : ShortString): Longint;
+{
+  Compares a AnsiString with a ShortString;
+  The result is
+   <0 if S1<S2
+   0 if S1=S2
+   >0 if S1>S2
+}
+Var
+  i,MaxI,Temp : Longint;
+begin
+  Temp:=0;
+  i:=0;
+  MaxI:=Length(AnsiString(S1));
+  if MaxI>byte(S2[0]) then
+    MaxI:=Byte(S2[0]);
+  While (i<MaxI) and (Temp=0) do
+   begin
+     Temp:= PByte(S1+I)^ - Byte(S2[i+1]);
+     inc(i);
+   end;
+  AnsiStr_ShortStr_Compare:=Temp;
+end;
+{$endif EXTRAANSISHORT}
+
+
+{*****************************************************************************
+                     Public functions, In interface.
+*****************************************************************************}
+
+Function Length (Const S : AnsiString) : Longint;
+{
+  Returns the length of an AnsiString.
+  Takes in acount that zero strings are NIL;
+}
+begin
+  If Pointer(S)=Nil then
+    Length:=0
+  else
+    Length:=PAnsiRec(Pointer(S)-FirstOff)^.Len;
+end;
+
 
 Procedure UniqueString(Var S : AnsiString); [Public,Alias : 'FPC_ANSISTR_UNIQUE'];
 {
@@ -666,7 +668,13 @@ end;
 
 {
   $Log$
-  Revision 1.5  2000-08-29 18:39:42  peter
+  Revision 1.6  2000-10-21 18:20:17  florian
+    * a lot of small changes:
+       - setlength is internal
+       - win32 graph unit extended
+       ....
+
+  Revision 1.5  2000/08/29 18:39:42  peter
     * fixed chararray to ansistring (merged)
 
   Revision 1.4  2000/08/24 07:37:21  jonas
@@ -680,4 +688,4 @@ end;
   Revision 1.2  2000/07/13 11:33:42  michael
   + removed logs
 
-}
+}

rtl/inc/charset.pp

@@ -39,7 +39,7 @@ unit charset;
 
        punicodemap = ^tunicodemap;
        tunicodemap = record
-          cpname : shortstring;
+          cpname : string[20];
           map : punicodecharmapping;
           lastchar : longint;
           next : punicodemap;
@@ -51,6 +51,10 @@ unit charset;
 
     function loadunicodemapping(const cpname,f : string) : punicodemap;
     procedure registermapping(p : punicodemap);
+    function getmap(const s : string) : punicodemap;
+    function mappingavailable(const s : string) : boolean;
+    function getunicode(c : char;p : punicodemap) : tunicodechar;
+    function getascii(c : tunicodechar;p : punicodemap) : string;
 
   implementation
 
@@ -84,9 +88,9 @@ unit charset;
               freemem(data,sizeof(tunicodecharmapping)*datasize);
               exit;
            end;
-         readln(t,s);
          while not(eof(t)) do
            begin
+              readln(t,s);
               if (s[1]='0') and (s[2]='x') then
                 begin
                    flag:=umf_unused;
@@ -147,7 +151,6 @@ unit charset;
                    if charpos>lastchar then
                      lastchar:=charpos;
                 end;
-              readln(t,s);
            end;
          close(t);
          new(p);
@@ -166,6 +169,70 @@ unit charset;
          mappings:=p;
       end;
 
+    function getmap(const s : string) : punicodemap;
+
+      var
+         hp : punicodemap;
+
+      const
+         mapcache : string = '';
+         mapcachep : punicodemap = nil;
+
+      begin
+         if (mapcache=s) and (mapcachep^.cpname=s) then
+           begin
+              getmap:=mapcachep;
+              exit;
+           end;
+         hp:=mappings;
+         while assigned(hp) do
+           begin
+              if hp^.cpname=s then
+                begin
+                   getmap:=hp;
+                   mapcache:=s;
+                   mapcachep:=hp;
+                   exit;
+                end;
+              hp:=hp^.next;
+           end;
+         getmap:=nil;
+      end;
+
+    function mappingavailable(const s : string) : boolean;
+
+      begin
+         mappingavailable:=getmap(s)<>nil;
+      end;
+
+    function getunicode(c : char;p : punicodemap) : tunicodechar;
+
+      begin
+         if ord(c)<=p^.lastchar then
+           getunicode:=p^.map[ord(c)].unicode
+         else
+           getunicode:=0;
+      end;
+
+    function getascii(c : tunicodechar;p : punicodemap) : string;
+
+      var
+         i : longint;
+
+      begin
+         { at least map to space }
+         getascii:=#32;
+         for i:=0 to p^.lastchar do
+           if p^.map[i].unicode=c then
+             begin
+                if i<256 then
+                  getascii:=chr(i)
+                else
+                  getascii:=chr(i div 256)+chr(i mod 256);
+                exit;
+             end;
+      end;
+
   var
      hp : punicodemap;
 
@@ -185,7 +252,12 @@ finalization
 end.
 {
   $Log$
-  Revision 1.1  2000-08-17 07:29:39  florian
-    + initial revision
+  Revision 1.2  2000-10-21 18:20:17  florian
+    * a lot of small changes:
+       - setlength is internal
+       - win32 graph unit extended
+       ....
 
-}
+  Revision 1.1  2000/08/17 07:29:39  florian
+    + initial revision
+}

rtl/inc/mathh.inc

@@ -49,6 +49,11 @@
 
     function power(bas,expo : longint) : longint;
 
+    type
+       real48 = array[0..5] of byte;
+
+    function Real2Double(r : real48) : double;
+
 {$ifdef HASFIXED}
     function sqrt(d : fixed) : fixed;
     function Round(x: fixed): longint;
@@ -61,7 +66,13 @@
 
 {
   $Log$
-  Revision 1.2  2000-07-13 11:33:44  michael
+  Revision 1.3  2000-10-21 18:20:17  florian
+    * a lot of small changes:
+       - setlength is internal
+       - win32 graph unit extended
+       ....
+
+  Revision 1.2  2000/07/13 11:33:44  michael
   + removed logs
  
 }

rtl/inc/rtti.inc

@@ -40,6 +40,7 @@ Const
        tkBool          = 18;
        tkInt64         = 19;
        tkQWord         = 20;
+       tkDynArray = 21;
 
 { A record is designed as follows :
     1    : tkrecord
@@ -88,7 +89,13 @@ TArrayRec = record
 
 {
   $Log$
-  Revision 1.2  2000-07-13 11:33:45  michael
+  Revision 1.3  2000-10-21 18:20:17  florian
+    * a lot of small changes:
+       - setlength is internal
+       - win32 graph unit extended
+       ....
+
+  Revision 1.2  2000/07/13 11:33:45  michael
   + removed logs
- 
-}
+
+}

rtl/inc/sstrings.inc

@@ -17,6 +17,16 @@
 ****************************************************************************}
 
 {$I real2str.inc}
+{$ifdef ver1_0}
+procedure SetLength(var s:shortstring;len:StrLenInt);
+{$else ver1_0}
+procedure Shortstr_SetLength(var s:shortstring;len:StrLenInt);[Public,Alias : 'FPC_SHORTSTR_SETLENGTH'];
+{$endif ver1_0}
+begin
+  if Len>255 then
+   Len:=255;
+  s[0]:=chr(len);
+end;
 
 function copy(const s : shortstring;index : StrLenInt;count : StrLenInt): shortstring;
 begin
@@ -133,15 +143,6 @@ begin
   pos:=0;
 end;
 
-
-procedure SetLength(var s:shortstring;len:StrLenInt);
-begin
-  if Len>255 then
-   Len:=255;
-  s[0]:=chr(len);
-end;
-
-
 function copy(c:char;index : StrLenInt;count : StrLenInt): shortstring;
 begin
   if (index=1) and (Count>0) then
@@ -558,12 +559,18 @@ end;
 
 {
   $Log$
-  Revision 1.3  2000-07-28 12:29:49  jonas
+  Revision 1.4  2000-10-21 18:20:17  florian
+    * a lot of small changes:
+       - setlength is internal
+       - win32 graph unit extended
+       ....
+
+  Revision 1.3  2000/07/28 12:29:49  jonas
     * fixed web bug1069
     * fixed similar (and other) problems in val() for int64 and qword
       (both merged from fixes branch)
 
   Revision 1.2  2000/07/13 11:33:45  michael
   + removed logs
- 
+
 }

rtl/inc/systemh.inc

@@ -93,15 +93,15 @@ Type
   PInt64      = ^Int64;
 
   currency            = int64;
-  HRESULT             = Longint; 
+  HRESULT             = Longint;
   TDateTime           = Double;
-  Error               = Longint;  
+  Error               = Longint;
 
   PSmallInt           = ^Smallint;
   PInteger            = ^Longint;
-  PSingle             = ^Single;  
+  PSingle             = ^Single;
   PDouble             = ^Double;
-  PCurrency           = ^Currency; 
+  PCurrency           = ^Currency;
   PDate               = ^TDateTime;
   PPWideChar          = ^PWideChar;
   PError              = ^Error;
@@ -267,13 +267,15 @@ function strpas(p:pchar):shortstring;
 function strlen(p:pchar):longint;
 
 { Shortstring functions }
+{$ifdef ver1_0}
+Procedure SetLength (Var S : ShortString; l : Longint);
+{$endif ver1_0}
 Function  Copy(const s:shortstring;index:StrLenInt;count:StrLenInt):shortstring;
 Procedure Delete(Var s:shortstring;index:StrLenInt;count:StrLenInt);
 Procedure Insert(const source:shortstring;Var s:shortstring;index:StrLenInt);
 Procedure Insert(source:Char;Var s:shortstring;index:StrLenInt);
 Function  Pos(const substr:shortstring;const s:shortstring):StrLenInt;
 Function  Pos(C:Char;const s:shortstring):StrLenInt;
-Procedure SetLength(var s:shortstring;len:StrLenInt);
 Procedure SetString (Var S : Shortstring; Buf : PChar; Len : Longint);
 Procedure SetString (Var S : AnsiString; Buf : PChar; Len : Longint);
 Function  Length(s:string):byte;
@@ -302,7 +304,9 @@ function  length(c:char):byte;
                              AnsiString Handling
 ****************************************************************************}
 
+{$ifdef ver1_0}
 Procedure SetLength (Var S : AnsiString; l : Longint);
+{$endif ver1_0}
 Procedure UniqueString (Var S : AnsiString);
 Function  Length (Const S : AnsiString) : Longint;
 Function  Copy (Const S : AnsiString; Index,Size : Longint) : AnsiString;
@@ -316,13 +320,17 @@ Function StringOfChar(c : char;l : longint) : AnsiString;
                              WideString Handling
 ****************************************************************************}
 
+{$ifdef haswidechar}
+{$ifdef ver1_0}
 Procedure SetLength (Var S : WideString; l : Longint);
+{$endif ver1_0}
 Procedure UniqueString (Var S : WideString);
 Function  Length (Const S : WideString) : Longint;
 Function  Copy (Const S : WideString; Index,Size : Longint) : WideString;
 Function  Pos (Const Substr : WideString; Const Source : WideString) : Longint;
 Procedure Insert (Const Source : WideString; Var S : WideString; Index : Longint);
 Procedure Delete (Var S : WideString; Index,Size: Longint);
+{$endif haswidechar}
 
 
 {****************************************************************************
@@ -476,7 +484,13 @@ const
 
 {
   $Log$
-  Revision 1.5  2000-08-13 17:55:15  michael
+  Revision 1.6  2000-10-21 18:20:17  florian
+    * a lot of small changes:
+       - setlength is internal
+       - win32 graph unit extended
+       ....
+
+  Revision 1.5  2000/08/13 17:55:15  michael
   + Added some delphi compatibility types
 
   Revision 1.4  2000/08/08 22:11:45  sg
@@ -487,5 +501,5 @@ const
 
   Revision 1.2  2000/07/13 11:33:45  michael
   + removed logs
- 
-}
+
+}

rtl/inc/wstrings.inc

@@ -294,25 +294,11 @@ begin
     HandleErrorFrame(201,get_frame);
 end;
 
-
-{*****************************************************************************
-                     Public functions, In interface.
-*****************************************************************************}
-
-Function Length (Const S : WideString) : Longint;
-{
-  Returns the length of an WideString.
-  Takes in acount that zero strings are NIL;
-}
-begin
-  If Pointer(S)=Nil then
-    Length:=0
-  else
-    Length:=PWideRec(Pointer(S)-WideFirstOff)^.Len;
-end;
-
-
+{$ifdef ver1_0}
 Procedure SetLength (Var S : WideString; l : Longint);
+{$else ver1_0}
+Procedure WideStr_SetLength (Var S : WideString; l : Longint);[Public,Alias : 'FPC_WIDESTR_SETLENGTH'];
+{$endif ver1_0}
 {
   Sets The length of string S to L.
   Makes sure S is unique, and contains enough room.
@@ -352,6 +338,25 @@ begin
 end;
 
 
+
+
+{*****************************************************************************
+                     Public functions, In interface.
+*****************************************************************************}
+
+Function Length (Const S : WideString) : Longint;
+{
+  Returns the length of an WideString.
+  Takes in acount that zero strings are NIL;
+}
+begin
+  If Pointer(S)=Nil then
+    Length:=0
+  else
+    Length:=PWideRec(Pointer(S)-WideFirstOff)^.Len;
+end;
+
+
 Procedure UniqueString(Var S : WideString); [Public,Alias : 'FPC_WIDESTR_UNIQUE'];
 {
   Make sure reference count of S is 1,
@@ -495,11 +500,17 @@ end;}
 
 {
   $Log$
-  Revision 1.3  2000-08-08 22:12:36  sg
+  Revision 1.4  2000-10-21 18:20:17  florian
+    * a lot of small changes:
+       - setlength is internal
+       - win32 graph unit extended
+       ....
+
+  Revision 1.3  2000/08/08 22:12:36  sg
   * Implemented WideString helper functions (but they are not tested yet
     due to the lack of full compiler support for WideString/WideChar!)
 
   Revision 1.2  2000/07/13 11:33:46  michael
   + removed logs
- 
-}
+
+}

rtl/win32/graph.pp

@@ -28,7 +28,16 @@ uses
     { this procedure allows to hook mouse messages }
     mousemessagehandler : function(Window: hwnd; AMessage, WParam,
                                    LParam: Longint): Longint;
-    mainwindow : HWnd;
+    { this procedure allows to wm_command messages }
+    commandmessagehandler : function(Window: hwnd; AMessage, WParam,
+                                   LParam: Longint): Longint;
+
+    NotifyMessageHandler : function(Window: hwnd; AMessage, WParam,
+                                   LParam: Longint): Longint;
+
+    OnGraphWindowCreation : procedure;
+
+    GraphWindow,ParentWindow : HWnd;
     // this allows direct drawing to the window
     bitmapdc : hdc;
     windc : hdc;
@@ -41,8 +50,15 @@ uses
     graphwindowstyle : DWord = cs_hRedraw or cs_vRedraw;
 
     windowtitle : pchar = 'Graph window application';
+    menu : hmenu = 0;
+    icon : hicon = 0;
     drawtoscreen : boolean = true;
     drawtobitmap : boolean = true;
+    // the graph window can be a child window, this allows to add toolbars
+    // to the main window
+    UseChildWindow : boolean = false;
+    // this allows to specify an offset for the child child window
+    ChildOffset : rect = (left:0;top:0;right:0;bottom:0);
 
 CONST
 
@@ -227,7 +243,7 @@ procedure DirectPutPixel16Win32GUI(x,y : integer);
          case currentwritemode of
            XorPut:
              Begin
-                c2:=Windows.GetPixel(bitmapdc,x,y);
+                c2:=Windows.GetPixel(windc,x,y);
                 c:=RGB(pal[col].red,pal[col].green,pal[col].blue) xor c2;
                 if drawtobitmap then
                   SetPixelV(bitmapdc,x,y,c);
@@ -236,7 +252,7 @@ procedure DirectPutPixel16Win32GUI(x,y : integer);
              End;
            AndPut:
              Begin
-                c2:=Windows.GetPixel(bitmapdc,x,y);
+                c2:=Windows.GetPixel(windc,x,y);
                 c:=RGB(pal[col].red,pal[col].green,pal[col].blue) and c2;
                 if drawtobitmap then
                   SetPixelV(bitmapdc,x,y,c);
@@ -245,7 +261,7 @@ procedure DirectPutPixel16Win32GUI(x,y : integer);
              End;
            OrPut:
              Begin
-                c2:=Windows.GetPixel(bitmapdc,x,y);
+                c2:=Windows.GetPixel(windc,x,y);
                 c:=RGB(pal[col].red,pal[col].green,pal[col].blue) or c2;
                 if drawtobitmap then
                   SetPixelV(bitmapdc,x,y,c);
@@ -740,13 +756,13 @@ procedure HLine16Win32GUI(x,x2,y: integer);
                   col:=CurrentColor;
                   for i:=x to x2 do
                     begin
-                       c2:=Windows.GetPixel(bitmapdc,i,y);
+                       c2:=Windows.GetPixel(windc,i,y);
                        c:=RGB(pal[col].red,pal[col].green,pal[col].blue) and c2;
                        if drawtobitmap then
-                         SetPixel(bitmapdc,i,y,c);
+                         SetPixelV(bitmapdc,i,y,c);
 
                        if drawtoscreen then
-                         SetPixel(windc,i,y,c);
+                         SetPixelV(windc,i,y,c);
                     end;
                   LeaveCriticalSection(graphdrawing);
                End;
@@ -756,14 +772,14 @@ procedure HLine16Win32GUI(x,x2,y: integer);
                   col:=CurrentColor;
                   for i:=x to x2 do
                     begin
-                       c2:=Windows.GetPixel(bitmapdc,i,y);
+                       c2:=Windows.GetPixel(windc,i,y);
                        c:=RGB(pal[col].red,pal[col].green,pal[col].blue) xor c2;
 
                        if drawtobitmap then
-                         SetPixel(bitmapdc,i,y,c);
+                         SetPixelV(bitmapdc,i,y,c);
 
                        if drawtoscreen then
-                         SetPixel(windc,i,y,c);
+                         SetPixelV(windc,i,y,c);
                     end;
                   LeaveCriticalSection(graphdrawing);
                End;
@@ -773,14 +789,14 @@ procedure HLine16Win32GUI(x,x2,y: integer);
                   col:=CurrentColor;
                   for i:=x to x2 do
                     begin
-                       c2:=Windows.GetPixel(bitmapdc,i,y);
+                       c2:=Windows.GetPixel(windc,i,y);
                        c:=RGB(pal[col].red,pal[col].green,pal[col].blue) or c2;
 
                        if drawtobitmap then
-                         SetPixel(bitmapdc,i,y,c);
+                         SetPixelV(bitmapdc,i,y,c);
 
                        if drawtoscreen then
-                         SetPixel(windc,i,y,c);
+                         SetPixelV(windc,i,y,c);
                     end;
                   LeaveCriticalSection(graphdrawing);
                End
@@ -1144,7 +1160,7 @@ procedure restorestate;
   begin
   end;
 
-function WindowProc(Window: HWnd; AMessage, WParam,
+function WindowProcGraph(Window: HWnd; AMessage, WParam,
                     LParam: Longint): Longint; stdcall; export;
 
   var
@@ -1156,7 +1172,7 @@ function WindowProc(Window: HWnd; AMessage, WParam,
      i : longint;
 
 begin
-  WindowProc := 0;
+  WindowProcGraph := 0;
 
   case AMessage of
     wm_lbuttondown,
@@ -1180,18 +1196,33 @@ begin
     wm_ncrbuttondblclk,
     wm_ncmbuttondblclk:
     }
-      if assigned(mousemessagehandler) then
-        WindowProc:=mousemessagehandler(window,amessage,wparam,lparam);
+      begin
+         if assigned(mousemessagehandler) then
+           WindowProcGraph:=mousemessagehandler(window,amessage,wparam,lparam);
+      end;
+    wm_notify:
+      begin
+         if assigned(notifymessagehandler) then
+           WindowProcGraph:=notifymessagehandler(window,amessage,wparam,lparam);
+      end;
+    wm_command:
+      if assigned(commandmessagehandler) then
+        WindowProcGraph:=commandmessagehandler(window,amessage,wparam,lparam);
     wm_keydown,
     wm_keyup,
     wm_char:
-      if assigned(charmessagehandler) then
-        WindowProc:=charmessagehandler(window,amessage,wparam,lparam);
+      begin
+         if assigned(charmessagehandler) then
+           WindowProcGraph:=charmessagehandler(window,amessage,wparam,lparam);
+      end;
     wm_paint:
       begin
 {$ifdef DEBUG_WM_PAINT}
          inc(wm_paint_count);
 {$endif DEBUG_WM_PAINT}
+{$ifdef DEBUGCHILDS}
+         writeln('Start child painting');
+{$endif DEBUGCHILDS}
          if not GetUpdateRect(Window,@r,false) then
            exit;
          EnterCriticalSection(graphdrawing);
@@ -1214,8 +1245,15 @@ begin
          assign(graphdebug,'wingraph.log');
          rewrite(graphdebug);
 {$endif DEBUG_WM_PAINT}
+{$ifdef DEBUGCHILDS}
+         writeln('Creating window (HWND: ',window,')... ');
+{$endif DEBUGCHILDS}
+         GraphWindow:=window;
          EnterCriticalSection(graphdrawing);
          dc:=GetDC(window);
+{$ifdef DEBUGCHILDS}
+         writeln('Window DC: ',dc);
+{$endif DEBUGCHILDS}
          bitmapdc:=CreateCompatibleDC(dc);
          savedscreen:=CreateCompatibleBitmap(dc,maxx+1,maxy+1);
          ReleaseDC(window,dc);
@@ -1239,14 +1277,20 @@ begin
 
          // clear predefined pens
          fillchar(pens,sizeof(pens),0);
-
+         if assigned(OnGraphWindowCreation) then
+           OnGraphWindowCreation;
          LeaveCriticalSection(graphdrawing);
+{$ifdef DEBUGCHILDS}
+         writeln('done');
+         GetClientRect(window,@r);
+         writeln('Window size: ',r.right,',',r.bottom);
+{$endif DEBUGCHILDS}
       end;
     wm_Destroy:
       begin
          EnterCriticalSection(graphdrawing);
          graphrunning:=false;
-         ReleaseDC(mainwindow,windc);
+         ReleaseDC(GraphWindow,windc);
          SelectObject(bitmapdc,oldbitmap);
          DeleteObject(savedscreen);
          DeleteDC(bitmapdc);
@@ -1270,7 +1314,33 @@ begin
          Exit;
       end
     else
-      WindowProc := DefWindowProc(Window, AMessage, WParam, LParam);
+      WindowProcGraph := DefWindowProc(Window, AMessage, WParam, LParam);
+  end;
+end;
+
+function WindowProcParent(Window: HWnd; AMessage, WParam,
+                    LParam: Longint): Longint; stdcall; export;
+
+begin
+  WindowProcParent := 0;
+  case AMessage of
+    wm_keydown,
+    wm_keyup,
+    wm_char:
+      begin
+         if assigned(charmessagehandler) then
+           WindowProcParent:=charmessagehandler(window,amessage,wparam,lparam);
+      end;
+    wm_notify:
+      begin
+         if assigned(notifymessagehandler) then
+           WindowProcParent:=notifymessagehandler(window,amessage,wparam,lparam);
+      end;
+    wm_command:
+      if assigned(commandmessagehandler) then
+        WindowProcParent:=commandmessagehandler(window,amessage,wparam,lparam);
+    else
+      WindowProcParent := DefWindowProc(Window, AMessage, WParam, LParam);
   end;
 end;
 
@@ -1279,19 +1349,69 @@ var
   WindowClass: WndClass;
 begin
   WindowClass.Style := graphwindowstyle;
-  WindowClass.lpfnWndProc := WndProc(@WindowProc);
+  WindowClass.lpfnWndProc := WndProc(@WindowProcGraph);
   WindowClass.cbClsExtra := 0;
   WindowClass.cbWndExtra := 0;
   WindowClass.hInstance := system.MainInstance;
-  WindowClass.hIcon := LoadIcon(0, idi_Application);
+  if icon<>0 then
+    WindowClass.hIcon := icon
+  else
+    WindowClass.hIcon := LoadIcon(0, idi_Application);
   WindowClass.hCursor := LoadCursor(0, idc_Arrow);
   WindowClass.hbrBackground := GetStockObject(BLACK_BRUSH);
-  WindowClass.lpszMenuName := nil;
+  if menu<>0 then
+    WindowClass.lpszMenuName := MAKEINTRESOURCE(menu)
+  else
+    WindowClass.lpszMenuName := nil;
   WindowClass.lpszClassName := 'FPCGraphWindow';
 
   winregister:=RegisterClass(WindowClass) <> 0;
 end;
 
+function WinRegisterWithChild: Boolean;
+var
+  WindowClass: WndClass;
+begin
+  WindowClass.Style := graphwindowstyle;
+  WindowClass.lpfnWndProc := WndProc(@WindowProcParent);
+  WindowClass.cbClsExtra := 0;
+  WindowClass.cbWndExtra := 0;
+  WindowClass.hInstance := system.MainInstance;
+  if icon<>0 then
+    WindowClass.hIcon := icon
+  else
+    WindowClass.hIcon := LoadIcon(0, idi_Application);
+  WindowClass.hCursor := LoadCursor(0, idc_Arrow);
+  WindowClass.hbrBackground := GetStockObject(BLACK_BRUSH);
+  if menu<>0 then
+    WindowClass.lpszMenuName := MAKEINTRESOURCE(menu)
+  else
+    WindowClass.lpszMenuName := nil;
+  WindowClass.lpszClassName := 'FPCGraphWindowMain';
+
+  WinRegisterWithChild:=RegisterClass(WindowClass) <> 0;
+{$ifdef DEBUGCHILDS}
+  writeln('Main window successfully registered: WinRegisterWithChild is ',WinRegisterWithChild);
+{$endif DEBUGCHILDS}
+  if WinRegisterWithChild then
+    begin
+       WindowClass.Style := CS_HREDRAW or CS_VREDRAW;
+       WindowClass.lpfnWndProc := WndProc(@WindowProcGraph);
+       WindowClass.cbClsExtra := 0;
+       WindowClass.cbWndExtra := 0;
+       WindowClass.hInstance := system.MainInstance;
+       WindowClass.hIcon := 0;
+       WindowClass.hCursor := LoadCursor(0, idc_Arrow);
+       WindowClass.hbrBackground := GetStockObject(BLACK_BRUSH);
+       WindowClass.lpszMenuName := nil;
+       WindowClass.lpszClassName := 'FPCGraphWindowChild';
+       WinRegisterWithChild:=RegisterClass(WindowClass)<>0;
+{$ifdef DEBUGCHILDS}
+       writeln('Child window registered: WinRegisterWithChild is ',WinRegisterWithChild);
+{$endif DEBUGCHILDS}
+    end;
+end;
+
 var
    // here we can force the creation of a maximized window }
    extrastyle : longint;
@@ -1301,20 +1421,52 @@ function WinCreate : HWnd;
 var
   hWindow: HWnd;
 begin
-
-  hWindow := CreateWindow('FPCGraphWindow', windowtitle,
-              ws_OverlappedWindow or extrastyle, CW_USEDEFAULT, 0,
-              maxx+1+2*GetSystemMetrics(SM_CXFRAME),
-              maxy+1+2*GetSystemMetrics(SM_CYFRAME)+
-                GetSystemMetrics(SM_CYCAPTION),
-              0, 0, system.MainInstance, nil);
-
-  if hWindow <> 0 then begin
-    ShowWindow(hWindow, SW_SHOW);
-    UpdateWindow(hWindow);
-  end;
-
-  wincreate:=hWindow;
+  WinCreate:=0;
+  if UseChildWindow then
+    begin
+       ParentWindow:=CreateWindow('FPCGraphWindowMain', windowtitle,
+                  WS_OVERLAPPEDWINDOW or WS_CLIPCHILDREN or extrastyle, CW_USEDEFAULT, 0,
+                  maxx+ChildOffset.Left+ChildOffset.Right+1+
+                    2*GetSystemMetrics(SM_CXFRAME),
+                  maxy+ChildOffset.Top+ChildOffset.Bottom+1+
+                    2*GetSystemMetrics(SM_CYFRAME)+
+                  GetSystemMetrics(SM_CYCAPTION),
+                  0, 0, system.MainInstance, nil);
+       if ParentWindow<>0 then
+         begin
+            ShowWindow(ParentWindow, SW_SHOW);
+            UpdateWindow(ParentWindow);
+         end
+       else
+         exit;
+       hWindow:=CreateWindow('FPCGraphWindowChild',nil,
+                  WS_CHILD, ChildOffset.Left,ChildOffset.Top,
+                  maxx+1,maxy+1,
+                  ParentWindow, 0, system.MainInstance, nil);
+       if hwindow<>0 then
+         begin
+            ShowWindow(hwindow, SW_SHOW);
+            UpdateWindow(hwindow);
+         end
+       else
+         exit;
+       WinCreate:=hWindow;
+    end
+  else
+    begin
+       hWindow:=CreateWindow('FPCGraphWindow', windowtitle,
+                  ws_OverlappedWindow or extrastyle, CW_USEDEFAULT, 0,
+                  maxx+1+2*GetSystemMetrics(SM_CXFRAME),
+                  maxy+1+2*GetSystemMetrics(SM_CYFRAME)+
+                  GetSystemMetrics(SM_CYCAPTION),
+                  0, 0, system.MainInstance, nil);
+       if hWindow <> 0 then
+         begin
+            ShowWindow(hWindow, SW_SHOW);
+            UpdateWindow(hWindow);
+            WinCreate:=hWindow;
+         end;
+    end;
 end;
 
 const
@@ -1328,15 +1480,26 @@ function MessageHandleThread(p : pointer) : DWord;StdCall;
   begin
      if not(winregistered) then
        begin
-          if not WinRegister then
+          if UseChildWindow then
+            begin
+               if not(WinRegisterWithChild) then
+                 begin
+                    MessageBox(0, 'Window registration failed', nil, mb_Ok);
+                    ExitThread(1);
+                 end;
+            end
+          else
             begin
-               MessageBox(0, 'Window registration failed', nil, mb_Ok);
-               ExitThread(1);
+               if not(WinRegister) then
+                 begin
+                    MessageBox(0, 'Window registration failed', nil, mb_Ok);
+                    ExitThread(1);
+                 end;
             end;
+          GraphWindow:=WinCreate;
           winregistered:=true;
        end;
-     MainWindow := WinCreate;
-     if longint(mainwindow) = 0 then begin
+     if longint(GraphWindow) = 0 then begin
        MessageBox(0, 'Window creation failed', nil, mb_Ok);
        ExitThread(1);
      end;
@@ -1383,7 +1546,10 @@ procedure CloseGraph;
          _graphresult := grnoinitgraph;
          exit
        end;
-     PostMessage(MainWindow,wm_destroy,0,0);
+     if UseChildWindow then
+       PostMessage(ParentWindow,wm_destroy,0,0)
+     else
+       PostMessage(GraphWindow,wm_destroy,0,0);
      PostThreadMessage(MessageThreadHandle,wm_quit,0,0);
      WaitForSingleObject(MessageThreadHandle,Infinite);
      CloseHandle(MessageThreadHandle);
@@ -2041,10 +2207,21 @@ function queryadapterinfo : pmodeinfo;
 
 begin
   InitializeGraph;
+  charmessagehandler:=nil;
+  mousemessagehandler:=nil;
+  commandmessagehandler:=nil;
+  notifymessagehandler:=nil;
+  OnGraphWindowCreation:=nil;
 end.
 {
   $Log$
-  Revision 1.2  2000-07-13 11:33:57  michael
+  Revision 1.3  2000-10-21 18:20:17  florian
+    * a lot of small changes:
+       - setlength is internal
+       - win32 graph unit extended
+       ....
+
+  Revision 1.2  2000/07/13 11:33:57  michael
   + removed logs
- 
-}
+
+}

rtl/win32/winmouse.pp

@@ -179,7 +179,7 @@ unit winmouse;
       begin
          buttons:=mousebuttonstate;
          GetCursorPos(@pos);
-         ScreenToClient(mainwindow,@pos);
+         ScreenToClient(GraphWindow,@pos);
          x:=pos.x;
          y:=pos.y;
       end;
@@ -200,7 +200,13 @@ unit winmouse;
   end.
 {
   $Log$
-  Revision 1.2  2000-07-13 11:33:58  michael
+  Revision 1.3  2000-10-21 18:20:17  florian
+    * a lot of small changes:
+       - setlength is internal
+       - win32 graph unit extended
+       ....
+
+  Revision 1.2  2000/07/13 11:33:58  michael
   + removed logs
- 
-}
+
+}