From 213e0cc3b189e1c569ac2291532bc22687b6d716 Mon Sep 17 00:00:00 2001
From: blikblum <blikblum@8e941d3f-bd1b-0410-a28a-d453659cc2b4>
Date: Fri, 6 Apr 2007 00:57:17 +0000
Subject: [PATCH] Fixed Panning window draw

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@141 8e941d3f-bd1b-0410-a28a-d453659cc2b4
---
 .../virtualtreeview-unstable/VirtualTrees.pas | 13 ++++++-----
 .../units/win32/virtualpanningwindow.pas      | 23 ++++++++-----------
 2 files changed, 16 insertions(+), 20 deletions(-)

diff --git a/components/virtualtreeview-unstable/VirtualTrees.pas b/components/virtualtreeview-unstable/VirtualTrees.pas
index f04e243e2..15b9e2061 100644
--- a/components/virtualtreeview-unstable/VirtualTrees.pas
+++ b/components/virtualtreeview-unstable/VirtualTrees.pas
@@ -23205,20 +23205,21 @@ procedure TBaseVirtualTree.StartWheelPanning(Position: TPoint);
   // Since we only work on a very small image (32x32 pixels) this is acceptable.
 
   var
-    Start, X, Y: Integer;
+    Start, X, Y, ImageHeight, ImageWidth: Integer;
     Temp: HRGN;
 
   begin
     Assert(not FPanningWindow.Image.Empty, 'Invalid wheel panning image.');
-
+    ImageWidth:= FPanningWindow.Image.Width;
+    ImageHeight:= FPanningWindow.Image.Height;
     // Create an initial region on which we operate.
     Result := CreateRectRgn(0, 0, 0, 0);
-    with FPanningWindow.Image, Canvas do
+    with FPanningWindow.Image.Canvas do
     begin
-      for Y := 0 to Height - 1 do
+      for Y := 0 to ImageHeight - 1 do
       begin
         Start := -1;
-        for X := 0 to Width - 1 do
+        for X := 0 to ImageWidth - 1 do
         begin
           // Start a new span if we found a non-transparent pixel and no span is currently started.
           if (Start = -1) and (Pixels[X, Y] <> clFuchsia) then
@@ -23236,7 +23237,7 @@ procedure TBaseVirtualTree.StartWheelPanning(Position: TPoint);
         // If there is an open span then add this also to the result region.
         if Start > -1 then
         begin
-          Temp := CreateRectRgn(Start, Y, Width, Y + 1);
+          Temp := CreateRectRgn(Start, Y, ImageWidth, Y + 1);
           CombineRgn(Result, Result, Temp, RGN_OR);
           DeleteObject(Temp);
         end;
diff --git a/components/virtualtreeview-unstable/units/win32/virtualpanningwindow.pas b/components/virtualtreeview-unstable/units/win32/virtualpanningwindow.pas
index fa2bf03ae..ffedb8640 100644
--- a/components/virtualtreeview-unstable/units/win32/virtualpanningwindow.pas
+++ b/components/virtualtreeview-unstable/units/win32/virtualpanningwindow.pas
@@ -1,5 +1,7 @@
 unit virtualpanningwindow;
 
+{Adapted from VirtualTrees by Luiz Américo to work in LCL/Lazarus}
+
 {$mode objfpc}{$H+}
 
 interface
@@ -8,7 +10,6 @@ uses
   Windows, Graphics, Classes, SysUtils;
   
 type
-
   { TVirtualPanningWindow }
 
   TVirtualPanningWindow = class
@@ -63,18 +64,10 @@ var
 procedure TVirtualPanningWindow.HandlePaintMessage;
 var
   PS: PaintStruct;
-  Canvas: TCanvas;
 begin
   BeginPaint(FHandle, PS);
-  Canvas := TCanvas.Create;
-  Canvas.Handle := PS.hdc;
-  try
-    Canvas.Draw(0, 0, FImage);
-  finally
-    Canvas.Handle := 0;
-    Canvas.Free;
-    EndPaint(FHandle, PS);
-  end;
+  BitBlt(PS.hdc,0,0,FImage.Width,FImage.Height,FImage.Canvas.Handle,0,0,SRCCOPY);
+  EndPaint(FHandle, PS);
 end;
 
 
@@ -83,10 +76,12 @@ var
   TempClass: TWndClass;
 begin
   // Register the helper window class.
-  PanningWindowClass.hInstance := HInstance;
   if not GetClassInfo(HInstance, PanningWindowClass.lpszClassName, TempClass) then
+  begin
+    PanningWindowClass.hInstance := HInstance;
     Windows.RegisterClass(PanningWindowClass);
-
+  end;
+  
   // Create the helper window and show it at the given position without activating it.
   with Position do
     FHandle := CreateWindowEx(WS_EX_TOOLWINDOW, PanningWindowClass.lpszClassName, nil, WS_POPUP, X - 16, Y - 16,
@@ -101,7 +96,6 @@ procedure TVirtualPanningWindow.Stop;
 begin
   // Destroy the helper window.
   DestroyWindow(FHandle);
-  FHandle := 0;
   FImage.Free;
   FImage := nil;
 end;
@@ -109,6 +103,7 @@ end;
 procedure TVirtualPanningWindow.Show(ClipRegion: HRGN);
 begin
   Logger.SendBitmap([lcPanning],'Panning Image',FImage);
+  //todo: move SetWindowRgn to DelphiCompat
   SetWindowRgn(FHandle, ClipRegion, False);
   ShowWindow(FHandle, SW_SHOWNOACTIVATE);
 end;