From 0ebc945aa37041e29c8adcb38666b63a1b14932c Mon Sep 17 00:00:00 2001 From: micha Date: Fri, 21 May 2004 09:03:55 +0000 Subject: [PATCH] implement new borderstyle - centralize to twincontrol (protected) - public expose at tcustomcontrol to let interface access it git-svn-id: trunk@5490 - --- components/synedit/synedit.pp | 11 +++++++++-- ideintf/objectinspector.pp | 22 +++------------------ lcl/comctrls.pp | 12 ++++++------ lcl/controls.pp | 20 +++++++++++++++---- lcl/extctrls.pp | 8 +++++--- lcl/forms.pp | 8 ++++---- lcl/grids.pas | 15 +++++++------- lcl/include/customform.inc | 24 ++++++++++++++++++----- lcl/include/customlistbox.inc | 11 ----------- lcl/include/custompanel.inc | 8 -------- lcl/include/customstatictext.inc | 15 +++++++++----- lcl/include/treeview.inc | 8 -------- lcl/include/wincontrol.inc | 26 +++++++++++++++++++++++++ lcl/interfaces/win32/win32int.pp | 7 ++++++- lcl/interfaces/win32/win32object.inc | 13 +++++++++---- lcl/interfaces/win32/win32wscontrols.pp | 10 ++++++++-- lcl/stdctrls.pp | 19 ++++++++++-------- lcl/widgetset/wscontrols.pp | 6 ++++++ 18 files changed, 146 insertions(+), 97 deletions(-) diff --git a/components/synedit/synedit.pp b/components/synedit/synedit.pp index 58bf27a32a..d746a937f0 100644 --- a/components/synedit/synedit.pp +++ b/components/synedit/synedit.pp @@ -334,7 +334,9 @@ type fMouseDownX: integer; fMouseDownY: integer; fBookMarkOpt: TSynBookMarkOpt; +{$ifndef SYN_LAZARUS} fBorderStyle: TBorderStyle; +{$endif} fHideSelection: boolean; fMouseWheelAccumulator: integer; fOverwriteCaret: TSynEditCaretType; @@ -429,8 +431,9 @@ type procedure SetBlockEnd(Value: TPoint); {$IFDEF SYN_LAZARUS} procedure SetBlockIndent(const AValue: integer); - {$ENDIF} + {$ELSE} procedure SetBorderStyle(Value: TBorderStyle); + {$ENDIF} procedure SetCaretAndSelection(ptCaret, ptBefore, ptAfter: TPoint); procedure SetCaretX(Value: Integer); procedure SetCaretY(Value: Integer); @@ -706,7 +709,7 @@ type protected property BookMarkOptions: TSynBookMarkOpt read fBookMarkOpt write fBookMarkOpt; - property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle + property BorderStyle {$ifndef SYN_LAZARUS}: TBorderStyle read FBorderStyle write SetBorderStyle{$endif} default bsSingle; {$IFDEF SYN_LAZARUS} property BlockIndent: integer read fBlockIndent write SetBlockIndent default 2; @@ -5546,6 +5549,8 @@ begin end; end; +{$ifndef SYN_LAZARUS} + procedure TCustomSynEdit.SetBorderStyle(Value: TBorderStyle); begin if fBorderStyle <> Value then begin @@ -5554,6 +5559,8 @@ begin end; end; +{$endif} + procedure TCustomSynEdit.SetHideSelection(const Value: boolean); begin if fHideSelection <> Value then begin diff --git a/ideintf/objectinspector.pp b/ideintf/objectinspector.pp index 87a29d9175..bf1ccd50ce 100644 --- a/ideintf/objectinspector.pp +++ b/ideintf/objectinspector.pp @@ -188,7 +188,6 @@ type FDragging:boolean; FOnModified: TNotifyEvent; FExpandedProperties:TStringList; - FBorderStyle:TBorderStyle; FStates: TOIPropertyGridStates; // hint stuff @@ -246,7 +245,6 @@ type ARect: TRect; State: TOwnerDrawState); procedure WMVScroll(var Msg: TWMScroll); message WM_VSCROLL; - procedure SetBorderStyle(Value: TBorderStyle); procedure SetBackgroundColor(const AValue: TColor); procedure UpdateScrollBar; protected @@ -293,8 +291,7 @@ type property NameFont:TFont read FNameFont write FNameFont; property ValueFont:TFont read FValueFont write FValueFont; property DefaultValueFont:TFont read FDefaultValueFont write FDefaultValueFont; - property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle - default bsSingle; + property BorderStyle default bsSingle; property ItemIndex:integer read FItemIndex write SetItemIndex; property ExpandedProperties:TStringList read FExpandedProperties write FExpandedProperties; @@ -562,28 +559,15 @@ end; procedure TOIPropertyGrid.CreateParams(var Params: TCreateParams); const - BorderStyles: array[TBorderStyle] of DWORD = (0, WS_BORDER); ClassStylesOff = CS_VREDRAW or CS_HREDRAW; begin inherited CreateParams(Params); with Params do begin {$R-} WindowClass.Style := WindowClass.Style and not ClassStylesOff; - Style := Style or WS_VSCROLL or BorderStyles[fBorderStyle] - or WS_CLIPCHILDREN; + Style := Style or WS_VSCROLL or WS_CLIPCHILDREN; {$R+} - if NewStyleControls and Ctl3D and (fBorderStyle = bsSingle) then begin - Style := Style and not Cardinal(WS_BORDER); - ExStyle := ExStyle or WS_EX_CLIENTEDGE; - end; - end; -end; - -procedure TOIPropertyGrid.SetBorderStyle(Value: TBorderStyle); -begin - if fBorderStyle <> Value then begin - fBorderStyle := Value; - Invalidate; + ExStyle := ExStyle or WS_EX_CLIENTEDGE; end; end; diff --git a/lcl/comctrls.pp b/lcl/comctrls.pp index 70d95b04c7..70694da09f 100644 --- a/lcl/comctrls.pp +++ b/lcl/comctrls.pp @@ -444,7 +444,6 @@ type TCustomListView = class(TWinControl) private - FBorderStyle: TBorderStyle; FDefItemHeight: integer; FSmallImages : TCustomImageList; FListItems : TListItems; @@ -508,7 +507,6 @@ type procedure ImageChanged(Sender : TObject); procedure WMHScroll(var Msg: TLMScroll); message LM_HSCROLL; procedure WMVScroll(var Msg: TLMScroll); message LM_VSCROLL; -// property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle; property Columns: TListColumns read FColumns write SetColumns; // property ColumnClick: Boolean read FColumnClick write SetColumnClick default True; property DefaultItemHeight: integer read FDefItemHeight write SetDefaultItemHeight; @@ -1801,7 +1799,6 @@ type TCustomTreeView = class(TCustomControl) private FBackgroundColor: TColor; - FBorderStyle: TBorderStyle; FBottomItem: TTreeNode; FExpandSignType: TTreeViewExpandSignType; FExpandSignSize: integer; @@ -1881,7 +1878,6 @@ type procedure OnChangeTimer(Sender: TObject); procedure SetAutoExpand(Value: Boolean); procedure SetBackgroundColor(Value: TColor); - procedure SetBorderStyle(Value: TBorderStyle); procedure SetBottomItem(Value: TTreeNode); procedure SetChangeDelay(Value: Integer); procedure SetDefaultItemHeight(Value: integer); @@ -1987,8 +1983,7 @@ type procedure WMSize(var Msg: TLMSize); message LM_SIZE; protected property AutoExpand: Boolean read GetAutoExpand write SetAutoExpand default False; - property BorderStyle: TBorderStyle - read FBorderStyle write SetBorderStyle default bsSingle; + property BorderStyle default bsSingle; property ChangeDelay: Integer read GetChangeDelay write SetChangeDelay default 0; property HideSelection: Boolean read GetHideSelection write SetHideSelection default True; @@ -2258,6 +2253,11 @@ end. { ============================================================================= $Log$ + Revision 1.127 2004/05/21 09:03:54 micha + implement new borderstyle + - centralize to twincontrol (protected) + - public expose at tcustomcontrol to let interface access it + Revision 1.126 2004/05/20 21:28:54 marc * Fixed win32 listview diff --git a/lcl/controls.pp b/lcl/controls.pp index e0862d01fd..7401c9bd3d 100644 --- a/lcl/controls.pp +++ b/lcl/controls.pp @@ -1240,8 +1240,8 @@ type TWinControl = class(TControl) private - FAlignLevel : Word; - FBorderWidth : TBorderWidth; + FAlignLevel: Word; + FBorderWidth: TBorderWidth; FBoundsLockCount: integer; FBoundsRealized: TRect; FBrush: TBrush; @@ -1280,6 +1280,7 @@ 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; @@ -1292,11 +1293,13 @@ type procedure SetChildSizing(const AValue: TControlChildSizing); procedure SetDockSite(const AValue: Boolean); procedure SetHandle(NewHandle: HWND); - Procedure SetBorderWidth(Value : TBorderWidth); - Procedure SetParentCtl3D(Value : Boolean); + procedure SetBorderWidth(Value : TBorderWidth); + procedure SetParentCtl3D(Value : Boolean); 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; @@ -1371,6 +1374,7 @@ 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; @@ -1407,6 +1411,8 @@ type procedure SetZOrderPosition(NewPosition: Integer); override; procedure SetZOrder(Topmost: Boolean); override; procedure SendMoveSizeMessages(SizeChanged, PosChanged: boolean); override; + + 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; @@ -1522,6 +1528,7 @@ type procedure Paint; virtual; property Canvas: TCanvas read FCanvas write FCanvas; + property BorderStyle; end; @@ -2262,6 +2269,11 @@ end. { ============================================================================= $Log$ + Revision 1.201 2004/05/21 09:03:54 micha + implement new borderstyle + - centralize to twincontrol (protected) + - public expose at tcustomcontrol to let interface access it + Revision 1.200 2004/05/11 12:16:47 mattias replaced writeln by debugln diff --git a/lcl/extctrls.pp b/lcl/extctrls.pp index 77e0e706e4..f687fcb47c 100644 --- a/lcl/extctrls.pp +++ b/lcl/extctrls.pp @@ -815,7 +815,6 @@ type FBevelInner, FBevelOuter : TPanelBevel; FBevelWidth : TBevelWidth; FBorderWidth : TBorderWidth; - FBorderStyle : TControlBorderStyle; FAlignment : TAlignment; // FCaption : TCaption; FFullRepaint: Boolean; @@ -824,7 +823,6 @@ type procedure SetBevelOuter(const Value: TPanelBevel); procedure SetBevelWidth(const Value: TBevelWidth); procedure SetBorderWidth(const Value: TBorderWidth); - procedure SetBorderStyle(const Value: TControlBorderStyle); protected procedure AdjustClientRect(var Rect: TRect); override; procedure RealSetText(const Value: TCaption); override; @@ -837,7 +835,6 @@ type property BevelOuter: TPanelBevel read FBevelOuter write SetBevelOuter default bvRaised; property BevelWidth: TBevelWidth read FBevelWidth write SetBevelWidth default 1; property BorderWidth: TBorderWidth read FBorderWidth write SetBorderWidth default 0; - property BorderStyle: TControlBorderStyle read FBorderStyle write SetBorderStyle default bsNone; property Color default clBtnFace; property Caption read GetText write SetText; property FullRepaint: Boolean read FFullRepaint write FFullRepaint default True; @@ -931,6 +928,11 @@ end. { $Log$ + Revision 1.103 2004/05/21 09:03:54 micha + implement new borderstyle + - centralize to twincontrol (protected) + - public expose at tcustomcontrol to let interface access it + Revision 1.102 2004/04/18 23:55:39 marc * Applied patch from Ladislav Michl * Changed the way TControl.Text is resolved diff --git a/lcl/forms.pp b/lcl/forms.pp index 950d96235a..99bc939d25 100644 --- a/lcl/forms.pp +++ b/lcl/forms.pp @@ -337,7 +337,6 @@ type private FActive: Boolean; FActiveControl: TWinControl; - FBorderStyle: TFormBorderStyle; FDesigner: TIDesigner; FDummyTextHeight: Longint; FFormState: TFormState; @@ -372,7 +371,7 @@ type function IsKeyPreviewStored: boolean; procedure SetActive(AValue: Boolean); procedure SetActiveControl(AWinControl: TWinControl); - procedure SetBorderStyle(Value : TFormBorderStyle); + procedure SetFormBorderStyle(Value: TFormBorderStyle); procedure SetDesigner(Value : TIDesigner); procedure SetFormStyle(Value : TFormStyle); procedure SetIcon(AValue: TIcon); @@ -410,7 +409,8 @@ type procedure Notification(AComponent: TComponent; Operation : TOperation);override; procedure PaintWindow(dc : Hdc); override; procedure RequestAlign; override; - Procedure SetZOrder(Topmost: Boolean); override; + procedure SetBorderStyle(NewStyle: TBorderStyle); override; + procedure SetZOrder(Topmost: Boolean); override; procedure UpdateShowing; override; procedure UpdateWindowState; procedure ValidateRename(AComponent: TComponent; @@ -446,7 +446,7 @@ type property Active: Boolean read FActive; property ActiveControl: TWinControl read FActiveControl write SetActiveControl; property BorderStyle: TFormBorderStyle - read FBorderStyle write SetBorderStyle default bsSizeable; + read FBorderStyle write SetFormBorderStyle default bsSizeable; property Caption stored IsForm; property Color default clBtnFace; property Designer: TIDesigner read FDesigner write SetDesigner; diff --git a/lcl/grids.pas b/lcl/grids.pas index a3fec6f310..fe0ecf1fd9 100644 --- a/lcl/grids.pas +++ b/lcl/grids.pas @@ -263,7 +263,6 @@ type TCustomGrid=class(TCustomControl) private FAutoAdvance: TAutoAdvance; - FBorderStyle: TBorderStyle; FDefaultDrawing: Boolean; FEditor: TWinControl; FEditorHiding: Boolean; @@ -339,7 +338,6 @@ type procedure ReadRowHeights(Reader: TReader); function ScrollToCell(const aCol,aRow: Integer): Boolean; function ScrollGrid(Relative:Boolean; DCol,DRow: Integer): TPoint; - procedure SetBorderStyle(const AValue: TBorderStyle); procedure SetCol(Valor: Integer); procedure SetColwidths(Acol: Integer; Avalue: Integer); procedure SetColCount(Valor: Integer); @@ -445,12 +443,13 @@ type procedure TopLeftChanged; dynamic; function TryMoveSelection(Relative: Boolean; var DCol, DRow: Integer): Boolean; procedure VisualChange; virtual; + procedure SetBorderStyle(NewStyle: TBorderStyle); override; procedure WMHScroll(var message : TLMHScroll); message LM_HScroll; procedure WMVScroll(var message : TLMVScroll); message LM_VScroll; procedure WndProc(var TheMessage : TLMessage); override; property AutoAdvance: TAutoAdvance read FAutoAdvance write FAutoAdvance default aaRight; - property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle; + property BorderStyle default bsSingle; property Col: Integer read FCol write SetCol; property ColCount: Integer read GetColCount write SetColCount; property ColWidths[aCol: Integer]: Integer read GetColWidths write SetColWidths; @@ -2300,10 +2299,12 @@ begin end; end; -procedure TCustomGrid.SetBorderStyle(const AValue: TBorderStyle); +procedure TCustomGrid.SetBorderStyle(NewStyle: TBorderStyle); begin - if FBorderStyle<>AValue Then begin - FBorderStyle := AValue; + if BorderStyle<>NewStyle then + begin + inherited; + VisualChange; if CheckTopLeft(Col, Row, True, True) then VisualChange; @@ -3699,7 +3700,7 @@ begin inherited Create(AOwner); //AutoScroll:=False; FFocusRectVisible := True; - FBorderStyle := bsSingle; //bsNone; + BorderStyle := bsSingle; FDefaultDrawing := True; FOptions:= [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, diff --git a/lcl/include/customform.inc b/lcl/include/customform.inc index 76cb386566..70dcd6484a 100644 --- a/lcl/include/customform.inc +++ b/lcl/include/customform.inc @@ -972,18 +972,27 @@ begin end; {------------------------------------------------------------------------------} -{ TCustomForm SetBorderStyle } +{ TCustomForm SetBorderStyle } {------------------------------------------------------------------------------} -Procedure TCustomForm.SetBorderStyle(Value : TFormBorderStyle); -Begin +procedure TCustomForm.SetBorderStyle(NewStyle: TBorderStyle); +begin + SetFormBorderStyle(NewStyle); +end; + +{------------------------------------------------------------------------------} +{ TCustomForm SetFormBorderStyle } +{------------------------------------------------------------------------------} +procedure TCustomForm.SetFormBorderStyle(Value: TFormBorderStyle); +begin if FBorderStyle = Value then exit; //TODO: Finish SETBORDERSTYLE FBorderStyle := Value; Include(FFormState,fsBorderStyleChanged); + inherited SetBorderStyle(Value); end; {------------------------------------------------------------------------------} -{ TCustomForm UpdateWindowState } +{ TCustomForm UpdateWindowState } {------------------------------------------------------------------------------} Procedure TCustomForm.UpdateWindowState; Begin @@ -992,7 +1001,7 @@ Begin end; {------------------------------------------------------------------------------} -{ TCustomForm SetWindowState } +{ TCustomForm SetWindowState } {------------------------------------------------------------------------------} Procedure TCustomForm.SetWindowState(Value : TWindowState); const @@ -1602,6 +1611,11 @@ end; { ============================================================================= $Log$ + Revision 1.136 2004/05/21 09:03:55 micha + implement new borderstyle + - centralize to twincontrol (protected) + - public expose at tcustomcontrol to let interface access it + Revision 1.135 2004/05/11 11:42:27 mattias replaced writeln by debugln diff --git a/lcl/include/customlistbox.inc b/lcl/include/customlistbox.inc index e8c36475dd..a6e31d903a 100644 --- a/lcl/include/customlistbox.inc +++ b/lcl/include/customlistbox.inc @@ -111,17 +111,6 @@ begin //DebugLn('[TCustomListBox.DestroyHandle] END ',FItems.ClassName); end; -{------------------------------------------------------------------------------} -{ procedure TCustomListBox.SetBorderStyle } -{------------------------------------------------------------------------------} -procedure TCustomListBox.SetBorderStyle(Val : TBorderStyle); -begin - if FBorderStyle <> Val then begin - FBorderStyle:= Val; - if HandleAllocated then CNSendMessage(LM_SETBORDER, Self, nil); - end; -end; - {------------------------------------------------------------------------------} { procedure TCustomListBox.UpdateSelectionMode } {------------------------------------------------------------------------------} diff --git a/lcl/include/custompanel.inc b/lcl/include/custompanel.inc index e77b68ec94..583cbe62b9 100644 --- a/lcl/include/custompanel.inc +++ b/lcl/include/custompanel.inc @@ -130,14 +130,6 @@ begin InflateRect(Rect, -BevelSize, -BevelSize); end; -procedure TCustomPanel.SetBorderStyle(const Value: TControlBorderStyle); -begin - if FBorderStyle <> Value then begin - FBorderStyle := Value; - Invalidate; - end; -end; - procedure TCustomPanel.RealSetText(const Value: TCaption); begin if Caption <> Value diff --git a/lcl/include/customstatictext.inc b/lcl/include/customstatictext.inc index f9321dc686..c9f1606007 100644 --- a/lcl/include/customstatictext.inc +++ b/lcl/include/customstatictext.inc @@ -88,17 +88,17 @@ begin Result := FAlignment; end; -Procedure TCustomStaticText.SetBorderStyle(Value : TStaticBorderStyle); +Procedure TCustomStaticText.SetStaticBorderStyle(Value : TStaticBorderStyle); begin - If FBorderStyle <> Value then begin - FBorderStyle := Value; + If FStaticBorderStyle <> Value then begin + FStaticBorderStyle := Value; Invalidate; end; end; -Function TCustomStaticText.GetBorderStyle : TStaticBorderStyle; +Function TCustomStaticText.GetStaticBorderStyle : TStaticBorderStyle; begin - Result := FBorderStyle; + Result := FStaticBorderStyle; end; Procedure TCustomStaticText.SetShowAccelChar(Value : Boolean); @@ -182,6 +182,11 @@ end; { $Log$ + Revision 1.6 2004/05/21 09:03:55 micha + implement new borderstyle + - centralize to twincontrol (protected) + - public expose at tcustomcontrol to let interface access it + Revision 1.5 2004/04/10 17:58:57 mattias implemented mainunit hints for include files diff --git a/lcl/include/treeview.inc b/lcl/include/treeview.inc index 2dccb5b85e..85e5ae9432 100644 --- a/lcl/include/treeview.inc +++ b/lcl/include/treeview.inc @@ -2881,14 +2881,6 @@ begin end; end; -procedure TCustomTreeView.SetBorderStyle(Value: TBorderStyle); -begin - if BorderStyle <> Value then begin - FBorderStyle := Value; - Invalidate; - end; -end; - procedure TCustomTreeView.Paint; begin DoPaint; diff --git a/lcl/include/wincontrol.inc b/lcl/include/wincontrol.inc index 2c4b665c61..887ca00610 100644 --- a/lcl/include/wincontrol.inc +++ b/lcl/include/wincontrol.inc @@ -986,6 +986,15 @@ Begin CNSendMessage(LM_RECREATEWND,Self,Nil); end; +{------------------------------------------------------------------------------} +{ TWinControl SetBorderStyle } +{------------------------------------------------------------------------------} +procedure TWinControl.SetBorderStyle(NewStyle: TBorderStyle); +begin + FBorderStyle := NewStyle; + TWSWinControlClass(WidgetSetClass).BorderStyleChanged(self); +end; + {------------------------------------------------------------------------------} { TWinControl SetBorderWidth } {------------------------------------------------------------------------------} @@ -2382,6 +2391,14 @@ begin Result := Control = Self; end; +{------------------------------------------------------------------------------ + TWinControl GetBorderStyle +------------------------------------------------------------------------------} +function TWinControl.GetBorderStyle: TBorderStyle; +begin + Result := TBorderStyle(FBorderStyle); +end; + {------------------------------------------------------------------------------ TWinControl GetBrush ------------------------------------------------------------------------------} @@ -2465,6 +2482,10 @@ end; constructor TWinControl.Create(TheOwner : TComponent); begin FCreatingHandle := False; + // do not set borderstyle, as tcustomform needs to set it before calling + // inherited, to have it set before handle is created via streaming + // use property that bsNone is zero + //FBorderStyle := bsNone; inherited Create(TheOwner); FCompStyle := csWinControl; FChildSizing:=TControlChildSizing.Create(Self); @@ -3523,6 +3544,11 @@ end; { ============================================================================= $Log$ + Revision 1.230 2004/05/21 09:03:55 micha + implement new borderstyle + - centralize to twincontrol (protected) + - public expose at tcustomcontrol to let interface access it + Revision 1.229 2004/05/19 18:41:54 micha trigger repaint on borderwidth change diff --git a/lcl/interfaces/win32/win32int.pp b/lcl/interfaces/win32/win32int.pp index 5ea2a00fb0..97e248ab5c 100644 --- a/lcl/interfaces/win32/win32int.pp +++ b/lcl/interfaces/win32/win32int.pp @@ -101,7 +101,6 @@ Type FStatusFont: HFONT; FMessageFont: HFONT; - Function RecreateWnd(Sender: TWinControl): Integer; virtual; Function GetOwnerHandle(ADialog : TCommonDialog): HWND; Function GetText(Sender: TComponent; Handle: HWND; var Data: String): Boolean; virtual; Procedure SetLabel(Sender: TObject; Data: Pointer); @@ -157,6 +156,7 @@ Type Procedure WaitMessage; Override; Procedure AppTerminate; Override; Function InitHintFont(HintFont: TObject): Boolean; Override; + Function RecreateWnd(Sender: TWinControl): Integer; virtual; Procedure AttachMenuToWindow(AMenuObject: TComponent); Override; // create and destroy @@ -254,6 +254,11 @@ End. { ============================================================================= $Log$ + Revision 1.80 2004/05/21 09:03:55 micha + implement new borderstyle + - centralize to twincontrol (protected) + - public expose at tcustomcontrol to let interface access it + Revision 1.79 2004/05/14 17:48:39 micha fix itemheight of listbox, handle measureitem message diff --git a/lcl/interfaces/win32/win32object.inc b/lcl/interfaces/win32/win32object.inc index e50f364df1..0266a0772c 100644 --- a/lcl/interfaces/win32/win32object.inc +++ b/lcl/interfaces/win32/win32object.inc @@ -287,7 +287,7 @@ Procedure TWin32WidgetSet.SetLabel(Sender: TObject; Data: Pointer); // retrieve page handle from tab as extra check (in case page isn't added yet). TCI.mask := TCIF_PARAM; Windows.SendMessage(NotebookHandle, TCM_GETITEM, PageIndex, LPARAM(@TCI)); - if TCI.lParam=Page.Handle then + if dword(TCI.lParam)=Page.Handle then begin Assert(False, Format('Trace:TWin32WidgetSet.SetLabel - label --> %S', [String(PChar(Data))])); TCI.mask := TCIF_TEXT; @@ -1923,6 +1923,9 @@ Begin Flags := Flags or WS_TABSTOP; Assert(False, 'Trace:Setting dimentions'); LCLBoundsToWin32Bounds(Sender, Left, Top, Width, Height); + if Sender is TCustomControl then + if TCustomControl(Sender).BorderStyle = bsSingle then + FlagsEx := FlagsEx or WS_EX_CLIENTEDGE; {$IFDEF VerboseSizeMsg} writeln('TWin32WidgetSet.CreateComponent A ',TControl(Sender).Name,':',TControl(Sender).ClassName,' ',Left,',',Top,',',Width,',',Height); {$ENDIF} @@ -2049,9 +2052,6 @@ Begin pClassName := @ClsName; WindowTitle := StrCaption; SubClassWndProc := nil; - if Sender is TTreeView then - if TTreeView(Sender).BorderStyle = bsSingle then - FlagsEx := FlagsEx or WS_EX_CLIENTEDGE; End; csForm: Begin @@ -2997,6 +2997,11 @@ End; { $Log$ + Revision 1.197 2004/05/21 09:03:55 micha + implement new borderstyle + - centralize to twincontrol (protected) + - public expose at tcustomcontrol to let interface access it + Revision 1.196 2004/05/20 21:28:54 marc * Fixed win32 listview diff --git a/lcl/interfaces/win32/win32wscontrols.pp b/lcl/interfaces/win32/win32wscontrols.pp index dd91d53df0..312df3c438 100644 --- a/lcl/interfaces/win32/win32wscontrols.pp +++ b/lcl/interfaces/win32/win32wscontrols.pp @@ -62,6 +62,7 @@ type private protected public + class procedure BorderStyleChanged(const AWinControl: TWinControl); override; end; { TWin32WSGraphicControl } @@ -92,13 +93,18 @@ type implementation uses - Windows, Win32Int; + Windows, Win32Int, InterfaceBase; procedure TWin32WSControl.SetCursor(const AControl: TControl; const ACursor: TCursor); begin Windows.SetCursor(Windows.LoadCursor(0, LclCursorToWin32CursorMap[ACursor])); end; +procedure TWin32WSWinControl.BorderStyleChanged(const AWinControl: TWinControl); +begin + TWin32WidgetSet(InterfaceObject).RecreateWnd(AWinControl); +end; + initialization //////////////////////////////////////////////////// @@ -109,7 +115,7 @@ initialization //////////////////////////////////////////////////// // RegisterWSComponent(TDragImageList, TWin32WSDragImageList); RegisterWSComponent(TControl, TWin32WSControl); -// RegisterWSComponent(TWinControl, TWin32WSWinControl); + RegisterWSComponent(TWinControl, TWin32WSWinControl); // RegisterWSComponent(TGraphicControl, TWin32WSGraphicControl); // RegisterWSComponent(TCustomControl, TWin32WSCustomControl); // RegisterWSComponent(TImageList, TWin32WSImageList); diff --git a/lcl/stdctrls.pp b/lcl/stdctrls.pp index 1804bb57f9..397c975e40 100644 --- a/lcl/stdctrls.pp +++ b/lcl/stdctrls.pp @@ -344,7 +344,6 @@ type TCustomListBox = class(TWinControl) private - FBorderStyle: TBorderStyle; FCanvas: TCanvas; FExtendedSelect, FMultiSelect : boolean; FIntegralHeight: boolean; @@ -374,7 +373,6 @@ type function GetSelected(Index : integer) : boolean; function GetCachedDataSize: Integer; virtual; // returns the amount of data needed per item function GetCachedData(const AIndex: Integer): Pointer; - procedure SetBorderStyle(Val : TBorderStyle); virtual; procedure SetExtendedSelect(Val : boolean); virtual; procedure SetItemIndex(Val : integer); virtual; procedure SetItems(Value : TStrings); virtual; @@ -397,7 +395,7 @@ type public property Align; property Anchors; - property BorderStyle : TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle; + property BorderStyle default bsSingle; property Canvas: TCanvas read FCanvas; property Constraints; property ExtendedSelect : boolean read FExtendedSelect write SetExtendedSelect; @@ -1002,8 +1000,8 @@ type TCustomStaticText = class(TCustomControl) Private FAlignment: TAlignment; - FBorderStyle: TStaticBorderStyle; - FFocusControl : TWinControl; + FStaticBorderStyle: TStaticBorderStyle; + FFocusControl: TWinControl; FShowAccelChar: Boolean; Procedure FontChange(Sender : TObject); protected @@ -1015,14 +1013,14 @@ type Procedure SetAlignment(Value : TAlignment); Function GetAlignment : TAlignment; - Procedure SetBorderStyle(Value : TStaticBorderStyle); - Function GetBorderStyle : TStaticBorderStyle; + Procedure SetStaticBorderStyle(Value : TStaticBorderStyle); + Function GetStaticBorderStyle : TStaticBorderStyle; Procedure SetFocusControl(Value : TWinControl); Procedure SetShowAccelChar(Value : Boolean); Function GetShowAccelChar : Boolean; property Alignment: TAlignment read GetAlignment write SetAlignment; - property BorderStyle: TStaticBorderStyle read GetBorderStyle write SetBorderStyle; + property BorderStyle: TStaticBorderStyle read GetStaticBorderStyle write SetStaticBorderStyle; property FocusControl : TWinControl read FFocusControl write SetFocusControl; property ShowAccelChar: Boolean read GetShowAccelChar write SetShowAccelChar; public @@ -1546,6 +1544,11 @@ end. { ============================================================================= $Log$ + Revision 1.142 2004/05/21 09:03:54 micha + implement new borderstyle + - centralize to twincontrol (protected) + - public expose at tcustomcontrol to let interface access it + Revision 1.141 2004/04/18 23:55:39 marc * Applied patch from Ladislav Michl * Changed the way TControl.Text is resolved diff --git a/lcl/widgetset/wscontrols.pp b/lcl/widgetset/wscontrols.pp index 85b1c590a2..978f6a6437 100644 --- a/lcl/widgetset/wscontrols.pp +++ b/lcl/widgetset/wscontrols.pp @@ -65,6 +65,8 @@ type { TWSWinControl } TWSWinControl = class(TWSControl) + class procedure BorderStyleChanged(const AWinControl: TWinControl); virtual; + class function GetText(const AWinControl: TWinControl; var AText: String): Boolean; virtual; class function GetTextLen(const AWinControl: TWinControl; var ALength: Integer): Boolean; virtual; @@ -105,6 +107,10 @@ end; { TWSWinControl } +procedure TWSWinControl.BorderStyleChanged(const AWinControl: TWinControl); +begin +end; + function TWSWinControl.GetText(const AWinControl: TWinControl; var AText: String): Boolean; begin Result := CNSendMessage(LM_GETTEXT, AWinControl, @AText) <> 0;