quick fixed crashing property overloading BorderStyle

git-svn-id: trunk@5495 -

components/synedit/synedit.pp

@@ -334,7 +334,7 @@ type
     fMouseDownX: integer;
     fMouseDownY: integer;
     fBookMarkOpt: TSynBookMarkOpt;
-{$ifndef SYN_LAZARUS}    
+{$ifndef SYN_LAZARUS}
     fBorderStyle: TBorderStyle;
 {$endif}    
     fHideSelection: boolean;
@@ -1212,7 +1212,11 @@ begin
   fInserting := True;
   fMaxLeftChar := 1024;
   fScrollBars := ssBoth;
+  {$IFDEF SYN_LAZARUS}
+  BorderStyle := bsSingle;
+  {$ELSE}
   fBorderStyle := bsSingle;
+  {$ENDIF}
   fInsertCaret := ctVerticalLine;
   fOverwriteCaret := ctBlock;
   FSelectionMode := smNormal;
@@ -1254,10 +1258,10 @@ begin
   with Params do begin
     {$IFOPT R+}{$DEFINE RangeCheckOn}{$R-}{$ENDIF}
     WindowClass.Style := WindowClass.Style and not Cardinal(ClassStylesOff);
-    Style := Style or ScrollBar[FScrollBars] or BorderStyles[fBorderStyle]
+    Style := Style or ScrollBar[FScrollBars] or BorderStyles[BorderStyle]
       or WS_CLIPCHILDREN;
     {$IFDEF RangeCheckOn}{$R+}{$ENDIF}
-    if NewStyleControls and Ctl3D and (fBorderStyle = bsSingle) then begin
+    if NewStyleControls and Ctl3D and (BorderStyle = bsSingle) then begin
       Style := Style and not Cardinal(WS_BORDER);
       ExStyle := ExStyle or WS_EX_CLIENTEDGE;
     end;

ideintf/componenttreeview.pas

@@ -95,7 +95,7 @@ begin
   end else begin
     if FComponentList.IsEqual(PropertyEditorHook.LookupRoot,NewSelection) then
     begin
-      // nodes ok, but maybe node values needs update
+      // nodes ok, but maybe node values need update
       UpdateComponentNodesValues;
       exit;
     end;

ideintf/objectinspector.pp

@@ -474,7 +474,7 @@ begin
   FValueFont.Color:=clMaroon;
   FDefaultValueFont:=TFont.Create;
   FDefaultValueFont.Color:=clActiveCaption;
-  fBorderStyle := bsSingle;
+  BorderStyle := bsSingle;
 
   // create sub components
   ValueEdit:=TEdit.Create(Self);

lcl/comctrls.pp

@@ -527,6 +527,7 @@ type
     property OnCompare: TLVCompareEvent read FOnCompare write FOnCompare;
     property OnDeletion: TLVDeletedEvent read FOnDeletion write FOnDeletion;
     property OnSelectItem: TLVSelectItemEvent read FOnSelectItem write FOnSelectItem;
+    property BorderStyle: TBorderStyle read GetBorderStyle write SetBorderStyle default bsSingle;
   public
     constructor Create(Aowner: TComponent); override;
     destructor Destroy; override;
@@ -2253,6 +2254,9 @@ end.
 { =============================================================================
 
   $Log$
+  Revision 1.128  2004/05/21 18:12:17  mattias
+  quick fixed crashing property overloading BorderStyle
+
   Revision 1.127  2004/05/21 09:03:54  micha
   implement new borderstyle
   - centralize to twincontrol (protected)

lcl/controls.pp

@@ -1244,6 +1244,7 @@ type
     FBorderWidth: TBorderWidth;
     FBoundsLockCount: integer;
     FBoundsRealized: TRect;
+    FBorderStyle: TBorderStyle;
     FBrush: TBrush;
     FAdjustClientRectRealized: TRect;
     FChildSizing: TControlChildSizing;
@@ -1280,7 +1281,6 @@ type
     FCreatingHandle: Boolean; // Set when constructing the handle
                               // Only used for checking
     procedure AlignControl(AControl : TControl);
-    function GetBorderStyle: TBorderStyle;
     function GetBrush: TBrush;
     function GetControl(const Index: Integer): TControl;
     function GetControlCount: Integer;
@@ -1298,8 +1298,6 @@ type
     procedure SetUseDockManager(const AValue: Boolean);
     procedure UpdateTabOrder(NewTabValue: TTabOrder);
   protected
-    FBorderStyle: TFormBorderStyle;
-
     procedure AssignTo(Dest: TPersistent); override;
     procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
     function GetActionLinkClass: TControlActionLinkClass; override;
@@ -1374,7 +1372,6 @@ type
     procedure DestroyWnd; virtual;
     procedure UpdateShowing; virtual;
     procedure Update; override;
-    procedure SetBorderStyle(NewStyle: TBorderStyle); virtual;
     procedure ShowControl(AControl: TControl); virtual;
     procedure WndProc(var Message : TLMessage); override;
     procedure DoAddDockClient(Client: TControl; const ARect: TRect); dynamic;
@@ -1412,7 +1409,9 @@ type
     procedure SetZOrder(Topmost: Boolean); override;
     procedure SendMoveSizeMessages(SizeChanged, PosChanged: boolean); override;
     
-    property BorderStyle: TBorderStyle read GetBorderStyle write SetBorderStyle default bsNone;
+    function GetBorderStyle: TBorderStyle;
+    procedure SetBorderStyle(NewStyle: TBorderStyle); virtual;
+    //property BorderStyle: TBorderStyle read GetBorderStyle write SetBorderStyle default bsNone;
   public
     property BorderWidth: TBorderWidth read FBorderWidth write SetBorderWidth default 0;
     property ChildSizing: TControlChildSizing read FChildSizing write SetChildSizing;
@@ -1528,7 +1527,7 @@ type
     procedure Paint; virtual;
 
     property Canvas: TCanvas read FCanvas write FCanvas;
-    property BorderStyle;
+    property BorderStyle: TBorderStyle read GetBorderStyle write SetBorderStyle default bsNone;
   end;
 
 
@@ -1735,7 +1734,7 @@ procedure Register;
 implementation
 
 uses
-  WSControls, // Widgetset uses are allowed
+  WSControls, // Widgetset uses circle is allowed
 
   Forms, // the circle can't be broken without breaking Delphi compatibility
   Math;  // Math is in RTL and only a few functions are used.
@@ -2269,6 +2268,9 @@ end.
 { =============================================================================
 
   $Log$
+  Revision 1.202  2004/05/21 18:12:17  mattias
+  quick fixed crashing property overloading BorderStyle
+
   Revision 1.201  2004/05/21 09:03:54  micha
   implement new borderstyle
   - centralize to twincontrol (protected)

lcl/forms.pp

@@ -388,6 +388,7 @@ type
     procedure WMShowWindow(var message: TLMShowWindow); message LM_SHOWWINDOW;
     procedure WMSize(var message: TLMSize); message LM_Size;
   protected
+    FFormBorderStyle: TFormBorderStyle;
     FActionLists: TList;
     function CloseQuery : boolean; virtual;
     function FormUpdating: boolean;
@@ -446,7 +447,7 @@ type
     property Active: Boolean read FActive;
     property ActiveControl: TWinControl read FActiveControl write SetActiveControl;
     property BorderStyle: TFormBorderStyle
-                      read FBorderStyle write SetFormBorderStyle default bsSizeable;
+                      read FFormBorderStyle write SetFormBorderStyle default bsSizeable;
     property Caption stored IsForm;
     property Color default clBtnFace;
     property Designer: TIDesigner read FDesigner write SetDesigner;
@@ -1052,6 +1053,8 @@ implementation
 
 
 uses
+  WSControls, // Widgetset uses circle is allowed
+  
   Math;
 
 var

lcl/include/application.inc

@@ -1130,9 +1130,10 @@ begin
   // set the Reference before the constructor is called, so that
   // events and constructors can refer to it
   TComponent(Reference) := Instance;
-  ok:=false;
+
   OldFindGlobalComponent:=FindGlobalComponent;
   FindGlobalComponent:=@FindApplicationComponent;
+  ok:=false;
   try
     Instance.Create(Self);
     ok:=true;
@@ -1179,6 +1180,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.80  2004/05/21 18:12:17  mattias
+  quick fixed crashing property overloading BorderStyle
+
   Revision 1.79  2004/05/11 11:42:26  mattias
   replaced writeln by debugln
 

lcl/include/customform.inc

@@ -984,11 +984,13 @@ end;
 {------------------------------------------------------------------------------}
 procedure TCustomForm.SetFormBorderStyle(Value: TFormBorderStyle);
 begin
-  if FBorderStyle = Value then exit;
+  if FFormBorderStyle = Value then exit;
   //TODO: Finish SETBORDERSTYLE
-  FBorderStyle := Value;
+  FFormBorderStyle := Value;
   Include(FFormState,fsBorderStyleChanged);
-  inherited SetBorderStyle(Value);
+  // ToDo: implement it.
+  // We can not use inherited SetBorderStyle(Value),
+  // because TBorderSTyle <> TFormBorderSTyle;
 end;
 
 {------------------------------------------------------------------------------}
@@ -1114,7 +1116,7 @@ Begin
   BeginFormUpdate;
   // set border style before handle is allocated
   if not (fsBorderStyleChanged in FFormState) then
-    FBorderStyle:= bsSizeable;
+    FFormBorderStyle:= bsSizeable;
   // set form style before handle is allocated
   if not (fsFormStyleChanged in FFormState) then
     FFormStyle:= fsNormal;
@@ -1611,6 +1613,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.137  2004/05/21 18:12:17  mattias
+  quick fixed crashing property overloading BorderStyle
+
   Revision 1.136  2004/05/21 09:03:55  micha
   implement new borderstyle
   - centralize to twincontrol (protected)

lcl/include/customlistbox.inc

@@ -371,7 +371,7 @@ constructor TCustomListBox.Create(AOwner : TComponent);
 begin
   inherited Create(AOwner);
   fCompStyle := csListBox;
-  FBorderStyle:= bsSingle;
+  BorderStyle:= bsSingle;
   FItems := TExtendedStringList.Create(GetCachedDataSize);
   FCacheValid := True;
   FItemIndex:=-1;

lcl/include/customlistview.inc

@@ -21,7 +21,7 @@ begin
   inherited Create(AOwner);
   FColumns := TListColumns.Create(self);
   FListItems := TListItems.Create(self);
-  FBorderStyle := bsSingle;
+  BorderStyle := bsSingle;
   FScrollBars := ssBoth;
   FSmallImages := nil;
   FCompStyle := csListView;
@@ -620,6 +620,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.37  2004/05/21 18:12:17  mattias
+  quick fixed crashing property overloading BorderStyle
+
   Revision 1.36  2004/05/20 21:28:54  marc
   * Fixed win32 listview
 

lcl/include/listitems.inc

@@ -198,11 +198,11 @@ var
   ItemHeader        : PItemHeader;
   ItemInfo          : PItemInfo;
   PStr              : PShortStr;
-  Flag              : Boolean;
+  //Flag              : Boolean;
   PInt              : PInteger;
 begin
   Clear;
-  Flag:=False;
+  //Flag:=False;
   Stream.ReadBuffer(Size, SizeOf(Integer));
   ItemHeader := AllocMem(Size);
   Owner.BeginUpdate;
@@ -214,7 +214,7 @@ begin
     begin
       with Add do
       begin
-        Flag:=True;
+        //Flag:=True;
         Caption := ItemInfo^.Caption;
         ImageIndex := ItemInfo^.ImageIndex;
         Data := ItemInfo^.Data;
@@ -333,6 +333,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.21  2004/05/21 18:12:17  mattias
+  quick fixed crashing property overloading BorderStyle
+
   Revision 1.20  2004/05/18 23:10:41  marc
   * Started to move TListview to the WS interface
 

lcl/include/treeview.inc

@@ -2596,7 +2596,7 @@ begin
   FExpandSignType:=tvestPlusMinus;
   FExpandSignSize:=9;
   FTreeNodes := TTreeNodes.Create(Self);
-  FBorderStyle := bsSingle;
+  BorderStyle := bsSingle;
   BorderWidth := 0;
   FOptions := DefaultTreeViewOptions;
   Items.KeepCollapsedNodes:=KeepCollapsedNodes;
@@ -2640,10 +2640,10 @@ begin
   with Params do begin
     {$IFOPT R+}{$DEFINE RangeCheckOn}{$R-}{$ENDIF}
     WindowClass.Style := WindowClass.Style and not Cardinal(ClassStylesOff);
-    Style := Style or ScrollBar[FScrollBars] or BorderStyles[fBorderStyle]
+    Style := Style or ScrollBar[FScrollBars] or BorderStyles[BorderStyle]
       or WS_CLIPCHILDREN;
     {$IFDEF RangeCheckOn}{$R+}{$ENDIF}
-    if NewStyleControls and Ctl3D and (fBorderStyle = bsSingle) then begin
+    if NewStyleControls and Ctl3D and (BorderStyle = bsSingle) then begin
       Style := Style and not Cardinal(WS_BORDER);
       ExStyle := ExStyle or WS_EX_CLIENTEDGE;
     end;

lcl/interfaces/gtk/gtkwscontrols.pp

@@ -27,7 +27,7 @@ unit GtkWSControls;
 interface
 
 uses
-  {$IFDEF GTK2} Gtk2, {$ELSE} Gtk, {$ENDIF}
+  {$IFDEF GTK2} Gtk2, Glib2, {$ELSE} Gtk, Glib, {$ENDIF}
 ////////////////////////////////////////////////////
 // I M P O R T A N T                                
 ////////////////////////////////////////////////////
@@ -104,14 +104,15 @@ uses
 
 { TGtkWSWinControl }
   
-procedure TGtkWSWinControl.SetBounds(const AWinControl: TWinControl; const ALeft, ATop, AWidth, AHeight: Integer); 
+procedure TGtkWSWinControl.SetBounds(const AWinControl: TWinControl;
+  const ALeft, ATop, AWidth, AHeight: Integer);
 var
   Allocation: TGTKAllocation;
 begin                
-  Allocation.X := ALeft;
+  Allocation.X := gint16(ALeft);
-  Allocation.Y := ATop;
+  Allocation.Y := gint16(ATop);
-  Allocation.Width := AWidth;
+  Allocation.Width := guint16(AWidth);
-  Allocation.Height := AHeight;
+  Allocation.Height := guint16(AHeight);
   gtk_widget_size_allocate(PGtkWidget(AWinControl.Handle), @Allocation);
 end;
 
@@ -148,10 +149,10 @@ var
   Allocation: TGTKAllocation;
 begin                
   Widget := PGtkWidget(AWinControl.Handle);
-  Allocation.X := ALeft;
+  Allocation.X := gint16(ALeft);
-  Allocation.Y := ATop;
+  Allocation.Y := gint16(ATop);
-  Allocation.Width := Widget^.Allocation.Width;
+  Allocation.Width := guint16(Widget^.Allocation.Width);
-  Allocation.Height := Widget^.Allocation.Height;
+  Allocation.Height := guint16(Widget^.Allocation.Height);
   gtk_widget_size_allocate(Widget, @Allocation);
 end;
 
@@ -163,8 +164,8 @@ begin
   Widget := PGtkWidget(AWinControl.Handle);
   Allocation.X := Widget^.Allocation.X;
   Allocation.Y := Widget^.Allocation.Y;
-  Allocation.Width := AWidth;
+  Allocation.Width := guint16(AWidth);
-  Allocation.Height := AHeight;
+  Allocation.Height := guint16(AHeight);
   gtk_widget_size_allocate(Widget, @Allocation);
 end;
 

lcl/stdctrls.pp

@@ -400,7 +400,7 @@ type
   public
     property Align;
     property Anchors;
-    property BorderStyle default bsSingle;
+    property BorderStyle: TBorderStyle read GetBorderStyle write SetBorderStyle default bsSingle;
     property Canvas: TCanvas read FCanvas;
     property Constraints;
     property ExtendedSelect : boolean read FExtendedSelect write SetExtendedSelect;
@@ -1549,6 +1549,9 @@ end.
 { =============================================================================
 
   $Log$
+  Revision 1.144  2004/05/21 18:12:17  mattias
+  quick fixed crashing property overloading BorderStyle
+
   Revision 1.143  2004/05/21 11:13:18  micha
   add measureitem to tcustomlistbox just like tcustomcombobox has