diff --git a/lcl/include/intfbaselcl.inc b/lcl/include/intfbaselcl.inc index 29245ae94d..b5187c7b7c 100644 --- a/lcl/include/intfbaselcl.inc +++ b/lcl/include/intfbaselcl.inc @@ -144,7 +144,7 @@ procedure TWidgetSet.DrawDefaultDockImage(AOldRect, ANewRect: TRect; AOperation: procedure DefaultDockImage(ARect: TRect); const - PenSize=4; + PenSize = 4; var DC: HDC; OldPen, NewPen: HPen; @@ -162,9 +162,9 @@ procedure TWidgetSet.DrawDefaultDockImage(AOldRect, ANewRect: TRect; AOperation: with ARect do begin MoveToEx(DC, Left+PenSize, Top+PenSize, nil); - LineTo(DC, Right-PenSize,Top+PenSize); + LineTo(DC, Right-PenSize, Top+PenSize); LineTo(DC, Right-PenSize, Bottom-PenSize); - LineTo(DC, Left+PenSize,Bottom-PenSize); + LineTo(DC, Left+PenSize, Bottom-PenSize); LineTo(DC, Left+PenSize, Top+PenSize); end; finally diff --git a/lcl/interfaces/win32/win32int.pp b/lcl/interfaces/win32/win32int.pp index 339143ba31..ba4c323b2b 100644 --- a/lcl/interfaces/win32/win32int.pp +++ b/lcl/interfaces/win32/win32int.pp @@ -157,8 +157,10 @@ type InitCommonControlsEx: function(ICC: PInitCommonControlsEx): LongBool; stdcall; FOnAsyncSocketMsg: TSocketEvent; + FDotsPatternBitmap: HBitmap; procedure AssignSelf(Window: HWnd; Data: Pointer); + function GetDotsPatternBitmap: HBitmap; { event handler helper functions } procedure HandleProcessEvent(AData: PtrInt; AFlags: dword); @@ -187,7 +189,7 @@ type procedure AppBringToFront; override; procedure AppProcessMessages; override; procedure AppWaitMessage; override; - Procedure AppTerminate; Override; + Procedure AppTerminate; override; procedure AppSetTitle(const ATitle: string); override; function InitHintFont(HintFont: TObject): Boolean; Override; @@ -214,6 +216,7 @@ type //property MessageFont: HFONT read FMessageFont; property CommonControlsVersion: DWord read FCommonControlsVersion; property OnAsyncSocketMsg: TSocketEvent read FOnAsyncSocketMsg write FOnAsyncSocketMsg; + property DotsPatternBitmap: HBitmap read GetDotsPatternBitmap; end; {$I win32listslh.inc} diff --git a/lcl/interfaces/win32/win32lclintf.inc b/lcl/interfaces/win32/win32lclintf.inc index a0ed1d60f4..7cdd97dd1b 100644 --- a/lcl/interfaces/win32/win32lclintf.inc +++ b/lcl/interfaces/win32/win32lclintf.inc @@ -272,6 +272,49 @@ begin DFC_SCROLL, ArrowTypeToState[TArrow(Arrow).ArrowType]); end; +procedure TWin32WidgetSet.DrawDefaultDockImage(AOldRect, ANewRect: TRect; AOperation: TDockImageOperation); +const + LineSize = 4; + + procedure DrawHorzLine(DC: HDC; x1, x2, y: integer); + begin + PatBlt(DC, x1, y, x2 - x1, LineSize, PATINVERT); + end; + + procedure DrawVertLine(DC: HDC; y1, y2, x: integer); + begin + PatBlt(DC, x, y1, LineSize, y2 - y1, PATINVERT); + end; + + procedure DefaultDockImage(ARect: TRect); + var + DC: HDC; + NewBrush, OldBrush: HBrush; + begin + DC := GetDCEx(0, 0, DCX_LOCKWINDOWUPDATE); // drawing during tracking + try + NewBrush := CreatePatternBrush(Win32WidgetSet.DotsPatternBitmap); + OldBrush := SelectObject(DC, NewBrush); + with ARect do + begin + DrawHorzLine(DC, Left, Right, Top); + DrawVertLine(DC, Top + LineSize, Bottom - LineSize, Left); + DrawHorzLine(DC, Left, Right, Bottom - LineSize); + DrawVertLine(DC, Top + LineSize, Bottom - LineSize, Right - LineSize); + end; + DeleteObject(SelectObject(DC, OldBrush)); + finally + ReleaseDC(0, DC); + end; + end; + +begin + if AOperation in [disMove, disHide] then + DefaultDockImage(AOldRect); + if AOperation in [disMove, disShow] then + DefaultDockImage(ANewRect); +end; + {------------------------------------------------------------------------------ Function: GetAcceleratorString Params: AVKey: diff --git a/lcl/interfaces/win32/win32lclintfh.inc b/lcl/interfaces/win32/win32lclintfh.inc index 5192ba5f24..10217fa962 100644 --- a/lcl/interfaces/win32/win32lclintfh.inc +++ b/lcl/interfaces/win32/win32lclintfh.inc @@ -41,6 +41,7 @@ function CreateStandardCursor(ACursor: SmallInt): hCursor; override; procedure DeallocateHWnd(Wnd: HWND); override; procedure DrawArrow(Arrow: TComponent; Canvas: TPersistent); override; +procedure DrawDefaultDockImage(AOldRect, ANewRect: TRect; AOperation: TDockImageOperation); override; function ExtUTF8Out(DC: HDC; X, Y: Integer; Options: Longint; Rect: PRect; Str: PChar; Count: Longint; Dx: PInteger): Boolean; override; diff --git a/lcl/interfaces/win32/win32object.inc b/lcl/interfaces/win32/win32object.inc index a89202dbec..e4aebbcbf1 100644 --- a/lcl/interfaces/win32/win32object.inc +++ b/lcl/interfaces/win32/win32object.inc @@ -42,6 +42,7 @@ begin OnClipBoardRequest := nil; Pointer(InitCommonControlsEx) := GetProcAddress(GetModuleHandle(comctl32), 'InitCommonControlsEx'); FCommonControlsVersion := GetFileVersion(comctl32); + FDotsPatternBitmap := 0; end; {------------------------------------------------------------------------------ @@ -72,6 +73,9 @@ begin end; FTimerData.Free; + + if FDotsPatternBitmap <> 0 then + DeleteObject(FDotsPatternBitmap); if FAppHandle <> 0 then DestroyWindow(FAppHandle); @@ -556,6 +560,15 @@ begin Assert(False, 'Trace:[TWin32WidgetSet.AssignSelf] Trying to code it. It''s probably wrong.'); end; +function TWin32WidgetSet.GetDotsPatternBitmap: HBitmap; +const + Dots: array[0..3] of Word = ($55, $AA, $55, $AA); +begin + if FDotsPatternBitmap = 0 then + FDotsPatternBitmap := CreateBitmap(4, 4, 1, 1, @Dots); + Result := FDotsPatternBitmap; +end; + {------------------------------------------------------------------------------ Method: TWin32WidgetSet.ShowHide Params: Sender - The sending object