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

win32: restore wm_erasebkgnd default handler after clDefault experiments

Browse Source 
lcl: more proper implementation for clDefault, add UseCLDefault define to compile with clDefault as default color for controls

git-svn-id: trunk@28140 -
This commit is contained in:
paul 2010-11-08 02:27:02 +00:00
parent ef89f04c0a
commit d35e85a332
12 changed files with 22 additions and 71 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
lcl/comctrls.pp
View File

@ -177,7 +177,7 @@ type
property AutoHint: Boolean read FAutoHint write FAutoHint default false;
property AutoSize default true;
property BorderSpacing;
property Color default clBtnFace;
property Color default {$ifdef UseCLDefault}clDefault{$else}clBtnFace{$endif};
property Constraints;
property DragCursor;
property DragKind;

2
lcl/controls.pp
View File

@ -1380,7 +1380,7 @@ type
property ClientOrigin: TPoint read GetClientOrigin;
property ClientRect: TRect read GetClientRect;
property ClientWidth: Integer read GetClientWidth write SetClientWidth stored IsClientWidthStored;
property Color: TColor read FColor write SetColor stored ColorIsStored default clWindow;
property Color: TColor read FColor write SetColor stored ColorIsStored default {$ifdef UseCLDefault}clDefault{$else}clWindow{$endif};
property Constraints: TSizeConstraints read FConstraints write SetConstraints;
property ControlOrigin: TPoint read GetControlOrigin;
property ControlState: TControlState read FControlState write FControlState;

2
lcl/extctrls.pp
View File

@ -1216,7 +1216,7 @@ type
property BevelInner: TPanelBevel read FBevelInner write SetBevelInner default bvNone;
property BevelOuter: TPanelBevel read FBevelOuter write SetBevelOuter default bvRaised;
property BevelWidth: TBevelWidth read FBevelWidth write SetBevelWidth default 1;
property Color default clBtnFace;
property Color default {$ifdef UseCLDefault}clDefault{$else}clBtnFace{$endif};
property FullRepaint: Boolean read FFullRepaint write FFullRepaint default True;
property ParentColor default true;
property TabStop default False;

2
lcl/forms.pp
View File

@ -636,7 +636,7 @@ type
read FFormBorderStyle write SetFormBorderStyle default bsSizeable;
property CancelControl: TControl read FCancelControl write SetCancelControl;
property Caption stored IsForm;
property Color default clBtnFace;
property Color default {$ifdef UseCLDefault}clDefault{$else}clBtnFace{$endif};
property DefaultControl: TControl read FDefaultControl write SetDefaultControl;
property DefaultMonitor: TDefaultMonitor read FDefaultMonitor
write FDefaultMonitor default dmActiveForm;

8
lcl/include/buttons.inc
View File

@ -28,10 +28,10 @@ begin
Inherited Create(TheOwner);
// set the component style to csButton
fCompStyle := csButton;
ControlStyle:=ControlStyle-[csClickEvents]+[csHasDefaultAction,csHasCancelAction];
Color:=clBtnFace;
ParentColor:=false;
TabStop := true;
ControlStyle := ControlStyle-[csClickEvents]+[csHasDefaultAction,csHasCancelAction];
Color := {$ifdef UseCLDefault}clDefault{$else}clBtnFace{$endif};
ParentColor := False;
TabStop := True;
// set default alignment
Align := alNone;
// setup default sizes

4
lcl/include/control.inc
View File

@ -4241,11 +4241,11 @@ begin
for Side:=Low(FAnchorSides) to High(FAnchorSides) do
FAnchorSides[Side]:=TAnchorSide.Create(Self,Side);
FBaseBounds.Right:=-1;
FBaseBounds.Right := -1;
FAnchors := [akLeft,akTop];
FAlign := alNone;
FCaptureMouseButtons := [mbLeft];
FColor := clWindow;
FColor := {$ifdef UseCLDefault}clDefault{$else}clWindow{$endif};
FVisible := True;
FParentBidiMode := True;
FParentColor := True;

6
lcl/include/customform.inc
View File

@ -1363,12 +1363,12 @@ end;
function TCustomForm.VisibleIsStored: boolean;
begin
Result:=Visible;
Result := Visible;
end;
function TCustomForm.ColorIsStored: boolean;
begin
Result := (Color <> clBtnFace);
Result := (Color <> {$ifdef UseCLDefault}clDefault{$else}clBtnFace{$endif});
end;
procedure TCustomForm.DoSendBoundsToInterface;
@ -1934,7 +1934,7 @@ begin
FIcon := TIcon.Create;
FIcon.OnChange := @IconChanged;
FKeyPreview := False;
Color := clBtnFace;
Color := {$ifdef UseCLDefault}clDefault{$else}clBtnFace{$endif};
FloatingDockSiteClass := TWinControlClass(ClassType);
Screen.AddForm(Self);
FAllowDropFiles := False;

2
lcl/include/custompanel.inc
View File

@ -40,7 +40,7 @@ begin
FBevelWidth := 1;
FAlignment := taCenter;
FFullRepaint := True;
Color := clBtnFace;
Color := {$ifdef UseCLDefault}clDefault{$else}clBtnFace{$endif};
with GetControlClassDefaultSize do
SetInitialBounds(0, 0, CX, CY);
ParentColor := True;

2
lcl/include/statusbar.inc
View File

@ -28,7 +28,7 @@ begin
FSimplePanel := True;
FSizeGrip := True;
FPanels := CreatePanels;
Color := clBtnFace;
Color := {$ifdef UseCLDefault}clDefault{$else}clBtnFace{$endif};
Align := alBottom;
AutoSize := True;
end;

14
lcl/include/wincontrol.inc
View File

@ -4826,7 +4826,6 @@ begin
FBrush.Color := TWSWinControlClass(WidgetSetClass).GetDefaultColor(Self)
else
FBrush.Color := Color;
// ToDo: ParentColor
end;
{------------------------------------------------------------------------------
@ -7052,13 +7051,8 @@ procedure TWinControl.WMEraseBkgnd(var Message: TLMEraseBkgnd);
begin
if (Message.DC <> 0) and (wcfEraseBackground in FWinControlFlags) then
begin
if Color = clDefault then
DefaultHandler(Message)
else
begin
EraseBackground(Message.DC);
Message.Result := 1;
end;
EraseBackground(Message.DC);
Message.Result := 1;
end;
end;
@ -7385,7 +7379,7 @@ begin
if TWSWinControlClass(WidgetSetClass).GetText(Self, S) then
FCaption := S;
// if color has changed make sure it will be restored
if FColor<>clWindow then
if FColor <> {$ifdef UseCLDefault}clDefault{$else}clWindow{$endif} then
Include(FWinControlFlags,wcfColorChanged);
RemoveProp(Handle,'WinControl');
FAdjustClientRectRealized := Rect(0,0,0,0);
@ -7496,7 +7490,7 @@ begin
begin
TWSWinControlClass(WidgetSetClass).SetColor(Self);
NotifyControls(CM_PARENTCOLORCHANGED);
Exclude(FWinControlFlags,wcfColorChanged);
Exclude(FWinControlFlags, wcfColorChanged);
end;
if wcfFontChanged in FWinControlFlags then
begin

45
lcl/interfaces/win32/win32winapi.inc
View File

@ -229,48 +229,6 @@ var
end;
end;
procedure CallEraseBkgndHandler;
var
ARect: TRect;
AColor: TColor;
ABrush: HBrush;
begin
// if window has a default bg brush or no DC is passed then just call a
// default windows handler
if TLMessage(Message).WParam = 0 then
begin
with TLMessage(Message) do
Result := CallDefaultWindowProc(Handle, Msg, WParam, LParam);
end
else
// we have a DC, so lets draw ourself
if GetClientRect(Handle, ARect) then
begin
ABrush := GetClassLongPtr(Handle, GCLP_HBRBACKGROUND);
if ABrush <> 0 then
begin
//DebugLn(['Found class color for window: ', WndClassName(Handle)]);
FillRect(HDC(TLMessage(Message).WParam), ARect, ABrush);
Exit;
end;
//DebugLn(['No class color for window: ', WndClassName(Handle)]);
// get the default color
if Sender is TControl then
AColor := TWSWinControlClass(TControl(Sender).WidgetSetClass).GetDefaultColor(TControl(Sender))
else
AColor := clBtnFace;
if IsSysColor(AColor) then
FillRect(HDC(TLMessage(Message).WParam), ARect, GetSysColorBrush(SysColorToSysColorIndex(AColor)))
else
begin
// not possible since default color must be system color. but who knows?
ABrush := CreateSolidBrush(AColor);
FillRect(HDC(TLMessage(Message).WParam), ARect, ABrush);
DeleteObject(ABrush);
end;
end;
end;
begin
Handle := ObjectToHwnd(Sender);
case TLMessage(Message).Msg of
@ -278,8 +236,7 @@ begin
CallWin32PaintHandler;
LM_MOUSEWHEEL: // provide default wheel scrolling functionality
CallMouseWheelHandler;
LM_ERASEBKGND:
CallEraseBkgndHandler;
LM_ERASEBKGND,
LM_GETDLGCODE,
LM_HELP:
with TLMessage(Message) do

4
lcl/stdctrls.pp
View File

@ -167,7 +167,7 @@ type
class function GetControlClassDefaultSize: TSize; override;
procedure CreateParams(var Params: TCreateParams); override;
public
constructor Create(AOwner: TComponent); Override;
constructor Create(AOwner: TComponent); override;
end;
@ -1113,7 +1113,7 @@ type
property Default: Boolean read FDefault write SetDefault default false;
property ModalResult: TModalResult read FModalResult write SetModalResult default mrNone;
property Cancel: Boolean read FCancel write SetCancel default false;
property Color default clBtnFace;
property Color default {$ifdef UseCLDefault}clDefault{$else}clBtnFace{$endif};
property TabStop default true;
end;