paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-21 18:20:27 +02:00
Code Issues Packages Projects Releases Wiki Activity

quick fixed crashing property overloading BorderStyle

Browse Source 
git-svn-id: trunk@5495 -
This commit is contained in:
mattias 2004-05-21 18:12:17 +00:00
parent a1dd0fce0a
commit c01cf47133
14 changed files with 71 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
components/synedit/synedit.pp
View File

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

2
ideintf/componenttreeview.pas
View File

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

2
ideintf/objectinspector.pp
View File

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

4
lcl/comctrls.pp
View File

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

16
lcl/controls.pp
View File

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

5
lcl/forms.pp
View File

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

6
lcl/include/application.inc
View File

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

13
lcl/include/customform.inc
View File

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

2
lcl/include/customlistbox.inc
View File

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

5
lcl/include/customlistview.inc
View File

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

9
lcl/include/listitems.inc
View File

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

6
lcl/include/treeview.inc
View File

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

25
lcl/interfaces/gtk/gtkwscontrols.pp
View File

@ -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.Y := ATop;
Allocation.Width := AWidth;
Allocation.Height := AHeight;
Allocation.X := gint16(ALeft);
Allocation.Y := gint16(ATop);
Allocation.Width := guint16(AWidth);
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.Y := ATop;
Allocation.Width := Widget^.Allocation.Width;
Allocation.Height := Widget^.Allocation.Height;
Allocation.X := gint16(ALeft);
Allocation.Y := gint16(ATop);
Allocation.Width := guint16(Widget^.Allocation.Width);
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.Height := AHeight;
Allocation.Width := guint16(AWidth);
Allocation.Height := guint16(AHeight);
gtk_widget_size_allocate(Widget, @Allocation);
end;

5
lcl/stdctrls.pp
View File

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