Keith: Fixed TPage creation

git-svn-id: trunk@603 -

lcl/interfaces/win32/win32int.pp

@@ -43,7 +43,7 @@ Var
   FormClassName: PChar;
 
 Const
-  ClsName = 'MainWinClass';
+  ClsName = 'LazarusForm';
 
 Type
   { Virtual alignment-control record }
@@ -65,7 +65,7 @@ Type
     FMessageQueue: TList;
     FToolTipWindow: HWND;
     FAccelGroup: HACCEL;
-    FTimerData : TList;       // Keeps track of timer event structures
+    FTimerData: TList;       // Keeps track of timer event structures
 
     FAlignment: TAlignment; // Tracks alignment
     FControlIndex: Cardinal; // Win32-API control index
@@ -88,7 +88,7 @@ Type
 
     Procedure CreateComponent(Sender: TObject);
     Procedure AddChild(Parent, Child: HWND; Left, Top: Integer);
-    Procedure ResizeChild(Sender: TObject; Left, Top, Width, Height: Integer);
+    Procedure ResizeChild(Window: HWND; Left, Top, Width, Height: Integer);
     Function GetLabel(CompStyle: Integer; Window: HWnd): String;
     Procedure AssignSelf(Window: HWnd; Data: Pointer);
     Procedure ReDraw(Child: TObject);
@@ -111,8 +111,8 @@ Type
     Procedure SetColor(Sender : TObject);
     Procedure SetPixel(Sender: TObject; Data: Pointer);
     Procedure GetPixel(Sender: TObject; Data: Pointer);
-    Function GetValue (Sender: TObject; Data: pointer): Integer;
+    Function GetValue (Sender: TObject; Data: Pointer): Integer;
-    Function SetValue (Sender: TObject; Data: pointer): Integer;
+    Function SetValue (Sender: TObject; Data: Pointer): Integer;
     Function SetProperties (Sender: TObject): Integer;
     Procedure AttachMenu(Sender: TObject);
 
@@ -129,6 +129,7 @@ Type
     Procedure DrawText(Child: TObject; Data: Pointer);
     Procedure PaintPixmap(Surface: TObject; PixmapData: Pointer);
     Procedure NormalizeIconName(Var IconName: String);
+    Procedure NormalizeIconName(Var IconName: PChar);
     Procedure CreateCommonDialog(Sender: TObject);
   Public
     { Constructor of the class }
@@ -155,7 +156,7 @@ Type
     Procedure DoEvents; Override;
     { Handle all events (Window messages) }
     Procedure HandleEvents; Override;
-    { Halt until a message is received }
+    { Wait until a message is received }
     Procedure WaitMessage; Override;
     { Abruptly halt execution of the program }
     Procedure AppTerminate; Override;
@@ -242,9 +243,7 @@ Type
     WParam: WPARAM;
     Win32Control: PWin32Control;
     Event: Pointer;
-    Draw: Record
+    Draw: TPoint;
-      X, Y: Integer;
-    End;
     ExtData: Pointer;
     Reserved: Pointer;
   End;
@@ -326,6 +325,9 @@ End.
 { =============================================================================
 
   $Log$
+  Revision 1.6  2002/01/17 03:17:44  lazarus
+  Keith: Fixed TPage creation
+
   Revision 1.5  2002/01/05 13:16:09  lazarus
   MG: win32 interface update from Keith Bowes
 

lcl/interfaces/win32/win32listsl.inc

@@ -19,8 +19,8 @@ Function DefaultCompareFunc(A, B: HWND): Integer; CDecl;
 Var
   AStr, BStr: PChar;
 Begin
-  GetWindowText(A, AStr, GetWindowTextLength(A) + 1);
+  GetWindowText(A, @AStr, GetWindowTextLength(A) + 1);
-  GetWindowText(B, BStr, GetWindowTextLength(B) + 1);
+  GetWindowText(B, @BStr, GetWindowTextLength(B) + 1);
   Result := StrComp(AStr, BStr);
 end;
 
@@ -106,7 +106,7 @@ Begin
     Raise Exception.Create('Out of bounds.')
   Else
   Begin
-    SendMessage(FWin32List, CB_GETLBTEXT, Index, LPARAM(Item));  
+    SendMessage(FWin32List, CB_GETLBTEXT, Index, LPARAM(@Item));  
   End;      
   Result := StrPas(Item);
 End;
@@ -262,7 +262,7 @@ Begin
     Raise Exception.Create('Out of bounds.')
   Else
   Begin
-    SendMessage(FWin32CList, CB_GETLBTEXT, Index, LPARAM(Item));
+    SendMessage(FWin32CList, CB_GETLBTEXT, Index, LPARAM(@Item));
     Result := StrPas(Item);
   End;
 End;
@@ -329,8 +329,10 @@ End;
 { =============================================================================
 
   $Log$
+  Revision 1.2  2002/01/17 03:17:44  lazarus
+  Keith: Fixed TPage creation
+
   Revision 1.1  2002/01/06 23:09:52  lazarus
   MG: added missing files
 
-
 }

lcl/interfaces/win32/win32object.inc

@@ -103,28 +103,29 @@ Var
   Ctrl: TNotebook;
   TCI: TC_ITEM;
 Begin
-  Assert(False, 'Trace:TWin32Object.GetText - Start');
+  Assert(False, Format('Trace:TWin32Object.GetText - Start --> %S', [Sender.ClassName]));
   Data := '';
   Result := True;
   Case Sender.FCompStyle Of
     csComboBox, csEdit, csMemo:
     Begin
       CapLen := GetWindowTextLength((Sender As TWinControl).Handle);
-      GetWindowText((Sender As TWinControl).Handle, Caption, CapLen + 1);
+      GetWindowText((Sender As TWinControl).Handle, @Caption, CapLen + 1);
+      Data := StrPas(PChar(@Caption));
     End;
     csPage:
     Begin 
       Assert(False, 'Trace:TWin32Object.GetText - csPage: Start');
-      Ctrl := (TNotebook(Sender));
+      Ctrl := ((Sender As TPage).Parent As TNotebook);
       Try
         Assert(False, 'Trace:TWin32Object.GetText - Filling TC_ITEM');
         TCI.mask := TCIF_TEXT;
         TCI.cchTextMax := MAX_PATH;
         TCI.pszText := StrAlloc(MAX_PATH);
         Assert(False, 'Trace:TWin32Object.GetText - Getting the text');
-        TabCtrl_GetItem(Ctrl.Handle, PLMNotebookEvent(@Sender)^.Page, TCI);
+        TabCtrl_GetItem(Ctrl.Handle, Ctrl.PageIndex, TCI);
-        Assert(False, 'Trace:TWin32Object.GetText - Returning the text');
         Data := String(TCI.pszText);
+        Assert(False, Format('Trace:TWin32Object.GetText - Returning the text --> %S', [Data]));
       Except
         StrDispose(TCI.pszText);
       End;
@@ -133,7 +134,7 @@ Begin
     Else
       Result := False;
   End;
-  Data := StrPas(Caption);
+  // Result := Data <> '';
 End;
 
 {------------------------------------------------------------------------------
@@ -358,7 +359,7 @@ Begin
     LM_SETPROPERTIES:
       Result := SetProperties(Sender);
     LM_SETDESIGNING:
-      EnableWindow(Handle, False);
+      EnableWindow((Sender As TWinControl).Handle, False);
     LM_RECREATEWND:
       Result := RecreateWnd(Sender);
     LM_ATTACHMENU:
@@ -1492,6 +1493,7 @@ Begin
 
   If (Sender Is TWinControl) And ((Sender As TWinControl).Parent <> Nil) Then
   Begin
+    Assert(False, Format('Trace: %S parent --> %S', [Sender.ClassName, TWinControl(Sender).Parent.ClassName]));
     Parent := (Sender As TWinControl).Parent.Handle;
     Assert(False, 'Trace:Setting parent');
   End
@@ -1582,7 +1584,7 @@ Begin
       Assert(False, 'Trace:CreateComponent - Button Window Handle Value = $' + IntToHex(Window, 8));
       Assert(False, 'Trace:CreateComponent - Creating a Button - SetProp');
       If Window <> HWND(Nil) Then
-        SetProp(Window, 'Lazarus', @Sender);
+        SetProp(Window, 'Lazarus', Sender);
       SetName(Window, StrTemp);
     End;
     csCalendar:
@@ -1614,10 +1616,12 @@ Begin
     End;
     csImage:
     Begin
+      DC := GetDC(Handle);
       With TImage(Sender).Picture.Bitmap Do
         Window := CreateBitmap(Width, Height, GetDeviceCaps(DC, PLANES), BitsPerPixel[Monochrome], Nil);
       SetOwner(Window, Sender);
       SetName(Window, StrTemp);
+      ReleaseDC(Handle, DC);
     End;
     csListBox:
     Begin
@@ -1673,13 +1677,13 @@ Begin
       Window := CreateWindow(ClsName, StrTemp, WS_OVERLAPPEDWINDOW, Left, Top, Width, Height, Parent, HMENU(Nil), HInstance, Nil);
       If Sender Is TForm Then
         OldClipboardViewer := SetClipboardViewer(Window);
-      If FMainForm = Nil Then
+      If (FMainForm = Nil) And (Application.MainForm = Nil) Then
         FMainForm := TForm(Sender);
       FParentWindow := Window;
       Assert(False, 'Trace:CreateComponent - Form Window Handle Value = $' + IntToHex(Window, 8));
       Assert(False, 'Trace:Creating a Form - SetProp');
       //SetProp(Window, 'Lazarus', @Sender);
-      SetProp(Window, 'Lazarus', Pointer(Sender));
+      SetProp(Window, 'Lazarus', Sender);
       If Window = 0 then
       Begin
         MessageBox(0, 'csForm CreateWindow Failed', nil, mb_Ok);
@@ -1862,30 +1866,48 @@ Begin
     // TPage - Notebook page 
     csPage:
     Begin
-      Assert(False, 'Trace:TODO:Create a csPage component.');
+      Assert(False, 'Trace:TODO: Create a csPage component.');
       Assert(False, 'Trace:Going to try it here.  I''m guaranteeing nothing.');
-      With TCI Do
-      Begin
-        Mask := TCIF_TEXT;
-        PSzText := StrTemp;
-      End;
       Assert(False, 'Trace:csPage - class name is ' + Sender.ClassName);
-      //Assert(False, Format('Trace:[TWin32Object.CreateComponent] csPage: Tab index=%D', [PLMNotebookEvent(@Sender)^.Page]));
+      With ((Sender As TPage).Parent As TNotebook) Do
-      Try
+      Begin
-        Window := TabCtrl_InsertItem((Sender As TWinControl).Parent.Handle, PLMNotebookEvent(@Sender)^.Page, TCI);
+        StrDispose(StrTemp);
-      Except
+        Try
-        Assert(False, 'Trace:csPage - Could not insert page');
+          Assert(False, Format('Trace:Page caption --> %S', [Page[PageIndex].Caption]));
-        Exit;
+          StrTemp := StrAlloc(Length(Page[PageIndex].Caption) + 1);
+          StrPCopy(StrTemp, Page[PageIndex].Caption);
+        Except
+          On E: Exception Do
+          Begin
+            Assert(False, Format('Trace:TWin32Object.CreateComponent - could not create in csPage --> %S', [E.Message]));
+            //Exit;
+          End;
+        End;
+        With TCI Do
+        Begin
+          Mask := TCIF_TEXT;
+          PSzText := StrTemp;
+        End;
+        Try
+          Assert(False, Format('Trace:Number of pages: %D, current page: %D', [Pages.Count, PageIndex]));
+          Window := TabCtrl_InsertItem(Handle, PageIndex, TCI);
+        Except
+          Assert(False, 'Trace:csPage - Could not insert page');
+          Exit;
+        End;
+        If PageIndex >= Pages.Count - 1 Then
+          TabCtrl_DeleteItem(Handle, Pages.Count);
+        PageIndex := PageIndex + 1;
+        SetProp(Handle, 'Lazarus', @Sender);
+        Self.SetName(Handle, StrTemp);
       End;
-      SetProp(Window, 'Lazarus', @Sender);
-      SetName(Window, strTemp);
     End;
     csPopupMenu:
     Begin
       Window := CreatePopupMenu;
       FSubMenu := Window;
       SetProp(Window, 'Lazarus', @Sender);
-      SetName(Window, strTemp);
+      SetName(Window, StrTemp);
     End;
     csProgressBar:
     Begin
@@ -1898,7 +1920,7 @@ Begin
       Assert(False, 'TRACE:CreateComponent - Creating a Track Bar (if we''re lucky)');
       Window := CreateWindow(TRACKBAR_CLASS, StrTemp, Flags, Left, Top, Width, Height, Parent, HMENU(Nil), HInstance, Nil);
       SetProp(Window, 'Lazarus', @Sender);
-      SetName(Window, strTemp);
+      SetName(Window, StrTemp);
     End;
   End; {Case}
  
@@ -1919,29 +1941,34 @@ Begin
     If (Sender Is TControl) Then
     Begin
       Assert(False, 'Trace:CreateComponent - Assigning window to TControl');
-      (Sender as TWinControl).Handle := Window;
+      (Sender As TWinControl).Handle := Window;
     End
     Else
       If (Sender Is TControlCanvas) Then
       Begin
         Assert(False, 'Trace:CreateComponent - Assigning window to TControlCanvas');
-        (Sender as TControlCanvas).Handle := Window;
+        (Sender As TControlCanvas).Handle := Window;
       End
       Else If (Sender Is TFont) Then
       Begin
         Assert(False, 'Trace:CreateComponent - Assigning P to TFont');
-        (Sender as TFont).Handle := Window;
+        (Sender As TFont).Handle := Window;
       End;
   End;
 
   SetLCLObject(Window, Sender);
+
   If Window = HWnd(Nil) Then
   Begin
     SetProp(Window, 'Style', Pointer(GetWindowLong(Window, GWL_Style)));
     SetProp(Window, 'ExStyle', Pointer(GetWindowLong(Window, GWL_ExStyle)));
   End;
 
-  StrDispose(StrTemp);
+  Try
+    StrDispose(StrTemp);
+  Except
+    Assert(False, 'Trace:Warning: Tried to dispose a string that was not allocated');
+  End;
 
   Assert(False, 'Trace:Leaving CreateComponent');
 End;
@@ -2023,9 +2050,9 @@ Var
   TCI: TC_ITEM;
 Begin
   Assert(False, 'Trace:TWin32Object.AddNBPage - Start');
-  Assert(False, Format('Trace:Adding notebook page %N', [Index]));
+  Assert(False, Format('Trace:Adding notebook page %D', [Index]));
 
-  PStr := StrAlloc(Length(TPage(Child).Caption) + 1);
+  {PStr := StrAlloc(Length(TPage(Child).Caption) + 1);
   Try
     StrPCopy(PStr, TPage(Child).Caption);
     With TCI Do
@@ -2042,7 +2069,7 @@ Begin
   End;
 
   PTabInfo(@Child)^.Caption := PChar(TPage(Child).Caption);
-  PTabInfo(@Child)^.Index := Index;
+  PTabInfo(@Child)^.Index := Index;}
   Assert(False, 'Trace:TWin32Object.AddNBPage - Exit');
 End;
 
@@ -2689,26 +2716,7 @@ End;
   Assigns a name to a window
  ------------------------------------------------------------------------------}
 Procedure TWin32Object.SetName(Window: HWND; Value: PChar);
-Var
-  I: Integer;
-  WndListed: Boolean;
 Begin
-  WndListed := False;
-
-  For I := 0 To WndList.Count - 1 Do
-  Begin
-    If HWND(WndList[I]) = Window Then
-    Begin
-      WndListed := True;
-    End;
-  End;
-
-  If Not WndListed Then
-  Begin
-    WndList.Capacity := WndList.Count;
-    WndList.Add(Pointer(Window));
-  End;
-
   SetProp(Window, 'Name', Value);
 End;
 
@@ -2721,27 +2729,8 @@ End;
   Assigns an owner object to a window
  ------------------------------------------------------------------------------}
 Procedure TWin32Object.SetOwner(Window: HWND; Owner: TObject);
-Var
-  I: Integer;
-  WndListed: Boolean;
 Begin
-  WndListed := False;
+  SetProp(Window, 'Lazarus', Owner);
-
-  For I := 0 To WndList.Count - 1 Do
-  Begin
-    If HWND(WndList[I]^) = Window Then
-    Begin
-      WndListed := True;
-    End;
-  End;
-
-  If Not WndListed Then
-  Begin
-    WndList.Capacity := WndList.Count;
-    WndList.Add(@Window);
-  End;
-
-  SetProp(Window, 'Lazarus', Pointer(Owner));
   SetProp(Window, 'MsgList', Nil);
 End;
 
@@ -2896,9 +2885,10 @@ Begin
 End;
 
 {
+  $Log$
+  Revision 1.6  2002/01/17 03:17:44  lazarus
+  Keith: Fixed TPage creation
 
-  Revision 1.5  2002/01/12 22:49:02 lazarus
-  Keith: Fixed compilation problem and some bugs
   
   Revision 1.4  2002/01/05 13:16:09  lazarus
   MG: win32 interface update from Keith Bowes

lcl/interfaces/win32/win32proc.inc

@@ -209,8 +209,8 @@ Begin
   $003D: Result := 'WM_GETOBJECT';
   $0041: Result := 'WM_COMPACTING';
   $0044: Result := 'WM_COMMNOTIfY { obsolete in Win32}';
-  $0046: Result := 'WM_WINDoWPOSCHANGING';
+  $0046: Result := 'WM_WINDOWPOSCHANGING';
-  $0047: Result := 'WM_WINDoWPOSCHANGED';
+  $0047: Result := 'WM_WINDOWPOSCHANGED';
   $0048: Result := 'WM_POWER';
   $004A: Result := 'WM_COPYDATA';
   $004B: Result := 'WM_CANCELJOURNAL';
@@ -235,26 +235,26 @@ Begin
   $0086: Result := 'WM_NCACTIVATE';
   $0087: Result := 'WM_GETDLGCODE';
   $00A0: Result := 'WM_NCMOUSEMOVE';
-  $00A1: Result := 'WM_NCLBUTTONDoWN';
+  $00A1: Result := 'WM_NCLBUTTONDOWN';
   $00A2: Result := 'WM_NCLBUTTONUP';
   $00A3: Result := 'WM_NCLBUTTONDBLCLK';
-  $00A4: Result := 'WM_NCRBUTTONDoWN';
+  $00A4: Result := 'WM_NCRBUTTONDOWN';
   $00A5: Result := 'WM_NCRBUTTONUP';
   $00A6: Result := 'WM_NCRBUTTONDBLCLK';
-  $00A7: Result := 'WM_NCMBUTTONDoWN';
+  $00A7: Result := 'WM_NCMBUTTONDOWN';
   $00A8: Result := 'WM_NCMBUTTONUP';
   $00A9: Result := 'WM_NCMBUTTONDBLCLK';
-  $0100: Result := 'WM_KEYFIRST or WM_KEYDoWN';
+  $0100: Result := 'WM_KEYFIRST or WM_KEYDOWN';
   $0101: Result := 'WM_KEYUP';
   $0102: Result := 'WM_CHAR';
   $0103: Result := 'WM_DEADCHAR';
-  $0104: Result := 'WM_SYSKEYDoWN';
+  $0104: Result := 'WM_SYSKEYDOWN';
   $0105: Result := 'WM_SYSKEYUP';
   $0106: Result := 'WM_SYSCHAR';
   $0107: Result := 'WM_SYSDEADCHAR';
   $0108: Result := 'WM_KEYLAST';
   $010D: Result := 'WM_IME_STARTCOMPOSITION';
-  $010E: Result := 'WM_IME_EndCOMPOSITION';
+  $010E: Result := 'WM_IME_ENDCOMPOSITION';
   $010F: Result := 'WM_IME_COMPOSITION or WM_IME_KEYLAST';
   $0110: Result := 'WM_INITDIALOG';
   $0111: Result := 'WM_COMMAND';
@@ -280,17 +280,17 @@ Begin
   $0137: Result := 'WM_CTLCOLORSCROLLBAR';
   $0138: Result := 'WM_CTLCOLORSTATIC';
   $0200: Result := 'WM_MOUSEFIRST or WM_MOUSEMOVE';
-  $0201: Result := 'WM_LBUTTONDoWN';
+  $0201: Result := 'WM_LBUTTONDOWN';
   $0202: Result := 'WM_LBUTTONUP';
   $0203: Result := 'WM_LBUTTONDBLCLK';
-  $0204: Result := 'WM_RBUTTONDoWN';
+  $0204: Result := 'WM_RBUTTONDOWN';
   $0205: Result := 'WM_RBUTTONUP';
   $0206: Result := 'WM_RBUTTONDBLCLK';
-  $0207: Result := 'WM_MBUTTONDoWN';
+  $0207: Result := 'WM_MBUTTONDOWN';
   $0208: Result := 'WM_MBUTTONUP';
   $0209: Result := 'WM_MBUTTONDBLCLK';
   $020A: Result := 'WM_MOUSEWHEEL or WM_MOUSELAST';
-  $0210: Result := 'WM_PARENTNOTIfY';
+  $0210: Result := 'WM_PARENTNOTIFY';
   $0211: Result := 'WM_ENTERMENULOOP';
   $0212: Result := 'WM_EXITMENULOOP';
   $0213: Result := 'WM_NEXTMENU';
@@ -315,13 +315,13 @@ Begin
   $0233: Result := 'WM_DROPFILES';
   $0234: Result := 'WM_MDIREFRESHMENU';
   $0281: Result := 'WM_IME_SETCONTEXT';
-  $0282: Result := 'WM_IME_NOTIfY';
+  $0282: Result := 'WM_IME_NOTIFY';
   $0283: Result := 'WM_IME_CONTROL';
   $0284: Result := 'WM_IME_COMPOSITIONFULL';
   $0285: Result := 'WM_IME_SELECT';
   $0286: Result := 'WM_IME_CHAR';
   $0288: Result := 'WM_IME_REQUEST';
-  $0290: Result := 'WM_IME_KEYDoWN';
+  $0290: Result := 'WM_IME_KEYDOWN';
   $0291: Result := 'WM_IME_KEYUP';
   $02A1: Result := 'WM_MOUSEHOVER';
   $02A3: Result := 'WM_MOUSELEAVE';
@@ -329,9 +329,9 @@ Begin
   $0301: Result := 'WM_COPY';
   $0302: Result := 'WM_PASTE';
   $0303: Result := 'WM_CLEAR';
-  $0304: Result := 'WM_UNDo';
+  $0304: Result := 'WM_UNDO';
-  $0305: Result := 'WM_REndERFORMAT';
+  $0305: Result := 'WM_RENDERFORMAT';
-  $0306: Result := 'WM_REndERALLFORMATS';
+  $0306: Result := 'WM_RENDERALLFORMATS';
   $0307: Result := 'WM_DESTROYCLIPBOARD';
   $0308: Result := 'WM_DRAWCLIPBOARD';
   $0309: Result := 'WM_PAINTCLIPBOARD';
@@ -610,7 +610,7 @@ End;
 Function Win32KeyState2ShiftState(KeyState: Word): TShiftState;
 Begin
   Assert(False, 'TRACE:Using Function Win32KeyState2ShiftState which isn''t implemented yet');
-  GetShiftState;
+  Result := GetShiftState;
 End;
 
 
@@ -899,6 +899,10 @@ End;
  { =============================================================================
 
   $Log$
+  Revision 1.4  2002/01/17 03:17:44  lazarus
+  Keith: Fixed TPage creation
+
+
   Revision 1.3  2002/01/05 13:16:10  lazarus
   MG: win32 interface update from Keith Bowes
 
@@ -908,4 +912,4 @@ End;
   Revision 1.1  2001/08/02 12:58:35  lazarus
   MG: win32 interface patch from Keith Bowes
 
-  }
+  }

lcl/interfaces/win32/win32winapi.inc

@@ -48,7 +48,6 @@ Const
   circle equals 5760 (16*360). Positive values of Angle and AngleLength mean
   counter-clockwise while negative values mean clockwise direction.
   Zero degrees is at the 3'o clock position. 
-
  ------------------------------------------------------------------------------}
 Function TWin32Object.Arc(DC: HDC; X, Y, Width, Height, Angle1, Angle2: Integer): Boolean;
 Begin
@@ -138,12 +137,9 @@ End;
   Returns: the corresponding mime type as string
  ------------------------------------------------------------------------------}
 Function TWin32Object.ClipboardFormatToMimeType(FormatID: TClipboardFormat): String;
-Var
-  GFN: PChar;
 Begin
   Assert(False, 'Trace:TWin32Object.ClipboardFormatToMimeType - Start');
-  Windows.GetClipboardFormatName(FormatID, GFN, MAX_PATH);
+  Windows.GetClipboardFormatName(FormatID, @Result, MAX_PATH);
-  Result := StrPas(GFN);
   Assert(False, 'Trace:TWin32Object.ClipboardFormatToMimeType - Exit');
 End;
 
@@ -216,13 +212,18 @@ Var
   I: Integer;
   P: PChar;
 Begin
+  Result := True;
   If GetClipboardOwner <> HWND(Nil) Then
     OnRequestProc(0, Nil);
   GetMem(Formats, FormatCount * SizeOf(TClipboardFormat));
-  For I := 0 To FormatCount Do
+  Try
-  Begin
+    For I := 0 To FormatCount Do
-    GetClipboardFormatName(Formats[I], @P, MAX_PATH);
+    Begin
-    RegisterClipboardFormat(@P);
+      GetClipboardFormatName(Formats[I], @P, MAX_PATH);
+      RegisterClipboardFormat(@P);
+    End;
+  Except
+    Result := False;
   End;
   FreeMem(Formats);
 End;
@@ -1422,10 +1423,32 @@ End;
 
   Adds a new entry or changes an existing entry in the property list of the
   specified window.
+
+  NOTE: LCLLinux has no RemoveProp function but Windows API requires all set
+  properties to be removed, so I'm keeping a list of windows with properties
+  for a properties-enumeration function that's called when the program is quit.
  ------------------------------------------------------------------------------}
 Function TWin32Object.SetProp(Handle: HWND; Str: PChar; Data: Pointer): Boolean;
+Var
+  C: Cardinal;
+  WndListed: Boolean;
 Begin
+  Assert(False, 'Trace:TWin32Object.SetProp - Start');
+  WndListed := False;
+
+  If WndList.Count > 0 Then
+    For C := 0 To WndList.Count - 1 Do
+      If HWND(WndList[C]) = Handle Then
+        WndListed := True;
+
+  If Not WndListed Then
+  Begin
+    WndList.Capacity := WndList.Count;
+    WndList.Add(Pointer(Handle));
+  End;
+
   Result := Windows.SetProp(Handle, Str, Integer(Data));
+  Assert(False, Format('Trace:TWin32Object.SetProp --> Window handle: 0x%X, Propery to set: %S, Data to set: 0x%P, Window was previously in list: %S, Property was successfully set: %S', [Handle, String(Str), Data, BOOL_RESULT[WndListed], BOOL_RESULT[Result]]));
 End;
 
 {------------------------------------------------------------------------------
@@ -1686,8 +1709,8 @@ End;
 { =============================================================================
 
   $Log$
-  Revision 1.1  2002/01/06 23:09:53  lazarus
+  Revision 1.2  2002/01/17 03:17:44  lazarus
-  MG: added missing files
+  Keith: Fixed TPage creation
 
 
 }

lcl/interfaces/win32/win32winapih.inc

@@ -34,11 +34,11 @@ Function CreateFontIndirect(Const LogFont: TLogFont): HFONT; Override;
 Function CreatePenIndirect(Const LogPen: TLogPen): HPEN; Override;
 { Creates a bitmap from raw pixmap data }
 Function CreatePixmapIndirect(Const Data: Pointer; Const TransColor: LongInt): HBITMAP; Override;
-Function CreateRectRgn(X1, Y1, X2, Y2: Integer): HRGN;
+Function CreateRectRgn(X1, Y1, X2, Y2: Integer): HRGN; Override;
 
 Function DeleteDC(HDC: HDC): Boolean; Override;
 Function DeleteObject(GDIObject: HGDIOBJ): Boolean; Override;
-Function DestroyCaret(Handle: HWND): Boolean;
+Function DestroyCaret(Handle: HWND): Boolean; Override;
 Function DrawFrameControl(DC: HDC; Var Rect: TRect; UType, UState: Cardinal): Boolean; Override;
 Function DrawEdge(DC: HDC; Var Rect: TRect; Edge: Cardinal; GrfFlags: Cardinal): Boolean; Override;
 
@@ -84,10 +84,10 @@ Function MaskBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc, YS
 Function MessageBox(HWnd: HWND; LPText, LPCaption: PChar; UType: Cardinal): Integer; Override;
 Function MoveToEx(DC: HDC; X, Y: Integer; OldPoint: PPoint): Boolean; Override;
 
-Function PeekMessage(Var LPMsg: TMsg; Handle: HWND; WMsgFilterMin, WMsgFilterMax, WRemoveMsg: UINT): Boolean; Override;
+Function PeekMessage(Var LPMsg: TMsg; Handle: HWND; WMsgFilterMin, WMsgFilterMax, WRemoveMsg: UINT): Boolean;
 Function Pie(DC: HDC; X, Y, Width, Height, Angle1, Angle2: Integer): Boolean; Override;
-Function Polygon(DC: HDC; Points: PPoint; NumPts: Integer; Winding: Boolean): Boolean;
+Function Polygon(DC: HDC; Points: PPoint; NumPts: Integer; Winding: Boolean): Boolean; Override;
-Function Polyline(DC: HDC; Points: PPoint; NumPts: Integer): Boolean;
+Function Polyline(DC: HDC; Points: PPoint; NumPts: Integer): Boolean; Override;
 Function PostMessage(HWnd: HWND; Msg: Cardinal; WParam: LongInt; LParam: LongInt): Boolean; Override;
 
 Function RealizePalette(DC: HDC): Cardinal; Override;
@@ -115,7 +115,7 @@ Function SetSysColors(CElements: Integer; Const LPAElements; Const LPARgbValues)
 Function SetTextCharacterExtra(_HDC: HDC; NCharExtra: Integer): Integer; Override;
 Function SetTextColor(DC: HDC; Color: TColorRef): TColorRef; Override;
 Function SetTimer(HWnd: HWND; NIDEvent, uElapse: Integer; LPTimerFunc: TFNTimerProc): Integer; Override;
-Function SetWindowLong(Handle: HWND; Idx: Integer; NewLong: LongInt): LongInt;
+Function SetWindowLong(Handle: HWND; Idx: Integer; NewLong: LongInt): LongInt; Override;
 Function SetWindowOrgEx(DC: HDC; NewX, NewY: Integer; Var Point: TPoint): Boolean; Override;
 Function SetWindowPos(HWnd: HWND; HWndInsertAfter: HWND; X, Y, CX, CY: Integer; UFlags: UINT): Boolean; Override;
 Function ShowCaret(HWnd: HWND): Boolean; Override;
@@ -131,6 +131,9 @@ Function WindowFromPoint(Point: TPoint): HWND; Override;
 { =============================================================================
 
   $Log$
+  Revision 1.2  2002/01/17 03:17:44  lazarus
+  Keith: Fixed TPage creation
+
   Revision 1.1  2002/01/06 23:09:53  lazarus
   MG: added missing files
 

lcl/interfaces/win32/winext.pas

@@ -1,6 +1,6 @@
 { 
   Extra Win32 code that's not in the RTL.
-  Copyright (C) 2001 Keith Bowes.
+  Copyright (C) 2001, 2002 Keith Bowes.
 
   This library is free software; you can redistribute it and/or
   modify it under the terms of the GNU Lesser General Public
@@ -15,6 +15,10 @@
 
 Unit WinExt;
 
+{$IFDEF TRACE}
+  {$ASSERTIONS ON}
+{$ENDIF}
+
 {$PACKRECORDS C}
 {$SMARTLINK ON}
 
@@ -173,7 +177,8 @@ Try
   StrDispose(TmpStr);
   TmpStr := Nil;
 Except
-  Exception.Create('Tried to deallocate a nil string');
+  On E: Exception Do
+    Assert(False, Format('Trace:Could not deallocate string --> %S', [E.Message]));
 End;
 
 End.