Fixed Panning window draw

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@141 8e941d3f-bd1b-0410-a28a-d453659cc2b4

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;

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;
+  BitBlt(PS.hdc,0,0,FImage.Width,FImage.Height,FImage.Canvas.Handle,0,0,SRCCOPY);
-  Canvas.Handle := PS.hdc;
+  EndPaint(FHandle, PS);
-  try
-    Canvas.Draw(0, 0, FImage);
-  finally
-    Canvas.Handle := 0;
-    Canvas.Free;
-    EndPaint(FHandle, PS);
-  end;
 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;