win32: make DrawDefaultDockImage more windows like

git-svn-id: trunk@14372 -

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

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}

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:

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;

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