Started to isolate specific windows functions

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

components/virtualtreeview-unstable/VTConfig.inc

@@ -35,3 +35,4 @@
 {$define EnableTimer}
 {.$define EnableAccessible}
 {$define UseExternalDragManager}
+{$define UseDelphiCompat}

components/virtualtreeview-unstable/VirtualTrees.pas

@@ -109,7 +109,12 @@ uses
   ActiveX,
   OleUtils,
   {$endif}
-  Windows, DelphiCompat, vtlogger,  LCLType, LResources, LCLIntf,  LMessages, Types,
+  {$ifdef UseDelphiCompat}
+  DelphiCompat,
+  {$else}
+  Windows,
+  {$endif}
+  vtlogger,  LCLType, LResources, LCLIntf,  LMessages, Types,
   SysUtils, Classes, Graphics, Controls, Forms, ImgList, StdCtrls, Menus, Printers,
   CommCtrl,  // image lists, common controls tree structures
   SyncObjs  // Thread support
@@ -4868,8 +4873,8 @@ var
       ButtonState := ButtonState or DFCS_CHECKED;
     if Flat then
       ButtonState := ButtonState or DFCS_FLAT;
-    //todo: remap to LCLIntf
-    Windows.DrawFrameControl(BM.Canvas.Handle, Rect(1, 2, BM.Width - 2, BM.Height - 1), DFC_BUTTON, ButtonType or ButtonState);
+    //lcl has difference to windows
+    DelphiCompat.DrawFrameControl(BM.Canvas.Handle, Rect(1, 2, BM.Width - 2, BM.Height - 1), DFC_BUTTON, ButtonType or ButtonState);
     IL.AddCopy(BM,nil);
     //IL.AddMasked(BM, MaskColor);
   end;
@@ -5019,10 +5024,13 @@ begin
   // Load all internal image lists and convert their colors to current desktop color scheme.
   // In order to use high color images we have to create the image list handle ourselves.
 
+  //todo: later remove flags when absolute sure is not necessary
+  {
   if IsWinNT then
     Flags := ILC_COLOR32 or ILC_MASK
   else
     Flags := ILC_COLOR16 or ILC_MASK;
+  }
   LightCheckImages := TImageList.CreateSize(16,16);
   //with LightCheckImages do
   //  Handle := ImageList_Create(16, 16, Flags, 0, AllocBy);
@@ -6645,7 +6653,7 @@ begin
           if Assigned(Node) and (LineBreakStyle = hlbForceMultiLine) then
             DrawFormat := DrawFormat or DT_WORDBREAK;
           if IsWinNT then
-            Windows.DrawTextW(Handle, PWideChar(HintText), Length(HintText), R, DrawFormat)
+            DelphiCompat.DrawTextW(Handle, PWideChar(HintText), Length(HintText), R, DrawFormat)
           else
             DrawTextW(Handle, PWideChar(HintText), Length(HintText), R, DrawFormat, False);
         end;
@@ -6942,7 +6950,7 @@ begin
               // in the caption (limited by carriage return), which results in unoptimal overlay of the tooltip.
               // On Windows NT the tooltip exactly overlays the node text.
               if IsWinNT then
-                Windows.DrawTextW(Canvas.Handle, PWideChar(HintText), Length(HintText), R, DT_CALCRECT or DT_WORDBREAK)
+                DelphiCompat.DrawTextW(Canvas.Handle, PWideChar(HintText), Length(HintText), R, DT_CALCRECT or DT_WORDBREAK)
               else
                 DrawTextW(Canvas.Handle, PWideChar(HintText), Length(HintText), R, DT_CALCRECT, True);
               if BidiMode = bdLeftToRight then
@@ -6984,7 +6992,7 @@ begin
             Result := Rect(0, 0, MaxWidth, FTextHeight);
             // Calculate the true size of the text rectangle.
             if IsWinNT then
-              Windows.DrawTextW(Canvas.Handle, PWideChar(HintText), Length(HintText), Result, DT_CALCRECT)
+              DelphiCompat.DrawTextW(Canvas.Handle, PWideChar(HintText), Length(HintText), Result, DT_CALCRECT)
             else
               DrawTextW(Canvas.Handle, PWideChar(HintText), Length(HintText), Result, DT_CALCRECT, True);
             // The height of the text plus 2 pixels vertical margin plus the border determine the hint window height.
@@ -7452,7 +7460,6 @@ var
   ScreenDC: HDC;
 
 begin
-  {$ifdef NeedWindows}
   // Recapturing means we want the tree to paint the new part into our back bitmap instead to the screen.
   if Visible then
   begin
@@ -7489,7 +7496,8 @@ begin
         // get the same effect.
         GetWindowRect(Tree.Handle, ClipRect);
         SetWindowOrgEx(Canvas.Handle, DragRect.Left - ClipRect.Left, DragRect.Top - ClipRect.Top, nil);
-        Tree.Perform(WM_PRINT, Integer(Canvas.Handle), PRF_NONCLIENT);
+        //todo: see what todo here
+        //Tree.Perform(WM_PRINT, Integer(Canvas.Handle), PRF_NONCLIENT);
         SetWindowOrgEx(Canvas.Handle, 0, 0, nil);
       end;
       SelectClipRgn(Canvas.Handle, 0);
@@ -7506,7 +7514,6 @@ begin
       end;
     end;
   end;
-  {$endif}
 end;
 
 //----------------------------------------------------------------------------------------------------------------------
@@ -8809,13 +8816,13 @@ begin
     OffsetRect(Bounds, 1, 1);
     SetTextColor(DC, ColorToRGB(clBtnHighlight));
     if IsWinNT then
-      Windows.DrawTextW(DC, PWideChar(Caption), Length(Caption), Bounds, DrawFormat)
+      DelphiCompat.DrawTextW(DC, PWideChar(Caption), Length(Caption), Bounds, DrawFormat)
     else
       DrawTextW(DC, PWideChar(Caption), Length(Caption), Bounds, DrawFormat, False);
     OffsetRect(Bounds, -1, -1);
     SetTextColor(DC, ColorToRGB(clBtnShadow));
     if IsWinNT then
-      Windows.DrawTextW(DC, PWideChar(Caption), Length(Caption), Bounds, DrawFormat)
+      DelphiCompat.DrawTextW(DC, PWideChar(Caption), Length(Caption), Bounds, DrawFormat)
     else
       DrawTextW(DC, PWideChar(Caption), Length(Caption), Bounds, DrawFormat, False);
   end
@@ -8826,7 +8833,7 @@ begin
     else
       SetTextColor(DC, ColorToRGB(FHeader.FFont.Color));
     if IsWinNT then
-      Windows.DrawTextW(DC, PWideChar(Caption), Length(Caption), Bounds, DrawFormat)
+      DelphiCompat.DrawTextW(DC, PWideChar(Caption), Length(Caption), Bounds, DrawFormat)
     else
       DrawTextW(DC, PWideChar(Caption), Length(Caption), Bounds, DrawFormat, False);
   end;
@@ -8928,23 +8935,24 @@ begin
       Width := ButtonR.Right - ButtonR.Left;
       if Width <= 32 then
       begin
-        ImageList_DrawEx(UtilityImages.Handle, 8, DC, ButtonR.Right - 16, ButtonR.Bottom - 3, 16, 3, CLR_NONE, CLR_NONE,
-          ILD_NORMAL);
-        ImageList_DrawEx(UtilityImages.Handle, 6, DC, ButtonR.Left, ButtonR.Bottom - 3, Width div 2, 3, CLR_NONE,
-          CLR_NONE, ILD_NORMAL);
+        //todo
+        //ImageList_DrawEx(UtilityImages.Handle, 8, DC, ButtonR.Right - 16, ButtonR.Bottom - 3, 16, 3, CLR_NONE, CLR_NONE,
+        //  ILD_NORMAL);
+        //ImageList_DrawEx(UtilityImages.Handle, 6, DC, ButtonR.Left, ButtonR.Bottom - 3, Width div 2, 3, CLR_NONE,
+        //  CLR_NONE, ILD_NORMAL);
       end
       else
       begin
-        ImageList_DrawEx(UtilityImages.Handle, 6, DC, ButtonR.Left, ButtonR.Bottom - 3, 16, 3, CLR_NONE, CLR_NONE,
-          ILD_NORMAL);
+        //ImageList_DrawEx(UtilityImages.Handle, 6, DC, ButtonR.Left, ButtonR.Bottom - 3, 16, 3, CLR_NONE, CLR_NONE,
+        //  ILD_NORMAL);
         // Replicate inner part as many times as need to fill up the button rectangle.
         XPos := ButtonR.Left + 16;
         repeat
-          ImageList_DrawEx(UtilityImages.Handle, 7, DC, XPos, ButtonR.Bottom - 3, 16, 3, CLR_NONE, CLR_NONE, ILD_NORMAL);
+          //ImageList_DrawEx(UtilityImages.Handle, 7, DC, XPos, ButtonR.Bottom - 3, 16, 3, CLR_NONE, CLR_NONE, ILD_NORMAL);
           Inc(XPos, 16);
         until XPos + 16 >= ButtonR.Right;
-        ImageList_DrawEx(UtilityImages.Handle, 8, DC, ButtonR.Right - 16, ButtonR.Bottom - 3, 16, 3, CLR_NONE, CLR_NONE,
-          ILD_NORMAL);
+        //ImageList_DrawEx(UtilityImages.Handle, 8, DC, ButtonR.Right - 16, ButtonR.Bottom - 3, 16, 3, CLR_NONE, CLR_NONE,
+        //  ILD_NORMAL);
       end;
     end
     else
@@ -17095,7 +17103,7 @@ begin
             NewCursor := Cursor;
 
           DoGetCursor(NewCursor);
-          Windows.SetCursor(Screen.Cursors[NewCursor]);
+          SetCursor(Screen.Cursors[NewCursor]);
           Message.Result := 1;
         end;
         //lcl does not have WMSetCursor
@@ -19614,9 +19622,9 @@ begin
               Inc(R.Top,FHeader.Height);
               Inc(R.Bottom,FHeader.Height);
             end;
-            Windows.ScrollWindow(Handle, DeltaX, 0, @R, @R);
+            DelphiCompat.ScrollWindow(Handle, DeltaX, 0, @R, @R);
             if DeltaY <> 0 then
-              Windows.ScrollWindow(Handle, 0, DeltaY, @R, @R);
+              DelphiCompat.ScrollWindow(Handle, 0, DeltaY, @R, @R);
           end
           else
           begin
@@ -20791,7 +20799,9 @@ var
   Data: PVTReference;
 
 begin
-  {$ifdef NeedWindows}
+  {$ifdef UseExternalDragManager}
+  Result:=TBaseVirtualTree(VirtualDragManager.GetTreeFromDataObject(DataObject,StandardOLEFormat));
+  {$else}
   Result := nil;
   if Assigned(DataObject) then
   begin
@@ -22406,7 +22416,7 @@ begin
       // a sliding window of the tree image.
       Logger.Send([lcPaintDetails],'FEffectiveOffsetX: %d, RTLOffset: %d, OffsetY: %d',[FEffectiveOffsetX,RTLOffset,FOffsetY]);
 
-      Windows.OffsetRect(Window, FEffectiveOffsetX - RTLOffset, -FOffsetY);
+      OffsetRect(Window, FEffectiveOffsetX - RTLOffset, -FOffsetY);
       Logger.Active:=Logger.CalledBy('DoDragging');
       PaintTree(Canvas, Window, Target, Options);
       Logger.Active:=True;
@@ -23848,8 +23858,9 @@ begin
 
     if not Handled then
     begin
-      if (Message.Msg in [WM_NCLBUTTONDOWN, WM_NCRBUTTONDOWN, WM_NCMBUTTONDOWN]) and not Focused and CanFocus then
-        SetFocus;
+      //lcl: probably not necessary
+      //if (Message.Msg in [WM_NCLBUTTONDOWN, WM_NCRBUTTONDOWN, WM_NCMBUTTONDOWN]) and not Focused and CanFocus then
+      //  SetFocus;
       inherited;
     end;
 
@@ -30304,7 +30315,7 @@ begin
     else
       SetBkMode(Canvas.Handle, OPAQUE);
     if IsWinNT then
-      Windows.DrawTextW(Canvas.Handle, PWideChar(Text), Length(Text), R, DrawFormat)
+      DelphiCompat.DrawTextW(Canvas.Handle, PWideChar(Text), Length(Text), R, DrawFormat)
     else
       DrawTextW(Canvas.Handle, PWideChar(Text), Length(Text), R, DrawFormat, False);
   end;

components/virtualtreeview-unstable/demos/ole/Main.lrs

@@ -1,5 +1,3 @@
-{ This is an automatically generated lazarus resource file }
-
 LazarusResources.Add('TMainForm','FORMDATA',[
   'TPF0'#9'TMainForm'#8'MainForm'#4'Left'#3'n'#1#6'Height'#3'?'#2#3'Top'#3#215#0
   +#5'Width'#3#22#3#18'HorzScrollBar.Page'#3#21#3#18'VertScrollBar.Page'#3'>'#2

components/virtualtreeview-unstable/lclfunctions.inc

@@ -90,169 +90,10 @@ end;
 
 function InvalidateRect(aHandle : HWND; ARect : pRect; bErase : Boolean) : Boolean;
 begin
-  //Logger.EnterMethod(lcPaint,'InvalidateRect');
-  //Logger.Send(lcPaint,'Rect',ARect^);
-  //Logger.SendCallStack(lcPaint,'CallStack');
-  Result:=Windows.InvalidateRect(aHandle,ARect,bErase);
-  //Logger.ExitMethod(lcPaint,'InvalidateRect');
+
+  Result:=InvalidateRect(aHandle,ARect,bErase);
 end;
 
-{$ifndef NeedWindows}
-
-//Dummy function. Used in many places
-function ImageList_DrawEx(himl:THandle; i:longint; hdcDst:HDC; x:longint;
-  y:longint;dx:longint; dy:longint; rgbBk:COLORREF; rgbFg:COLORREF; fStyle:UINT):Boolean;
-begin
-  Logger.AddCheckPoint(lcDummyFunctions,'ImageList_DrawEx');
-end;
-
-//Used in TVirtualTreeColumns.AnimatedResize
-function GetWindowDC(hWnd:HWND):HDC;
-begin
-  Logger.AddCheckPoint(lcDummyFunctions,'GetWindowDC');
-end;
-
-//Used in TVTDragImage.DragTo, TVirtualTreeColumns.AnimatedResize, TBaseVirtualTree.ToggleCallback,
-//TBaseVirtualTree.TileBackground
-
-function ScrollDC(hDC:HDC; dx:longint; dy:longint; var lprcScroll:TRECT;
-  var lprcClip:TRECT;hrgnUpdate:HRGN; lprcUpdate:PRECT):Boolean;
-begin
-  Logger.AddCheckPoint(lcDummyFunctions,'ScrollDC');
-end;
-
-
-// TCustomVirtualTreeOptions.SetPaintOptions, TVTHeader.Invalidate, TVTColors.SetColor
-//CMEnabledChanged, TBaseVirtualTree.WMEnable, TBaseVirtualTree.WMVScroll,
-// TBaseVirtualTree.UpdateWindowAndDragImage, TBaseVirtualTree.RepaintNode
-function RedrawWindow(hWnd:HWND; lprcUpdate:PRECT; hrgnUpdate:HRGN;
-  flags:LongWord):Boolean; overload;
-begin
-  Logger.AddCheckPoint(lcDummyFunctions,'RedrawWindow');
-end;
-
-function RedrawWindow(hWnd:HWND; var lprcUpdate:TRECT; hrgnUpdate:HRGN;
-  flags:UINT):Boolean; overload;
-begin
-end;
-//Used in LimitPaintingToArea
-function LPtoDP(_para1:HDC; _para2:PPOINT; _para3:longint):Boolean;
-begin
-  Logger.AddCheckPoint(lcDummyFunctions,'LPtoDP');
-end;
-
-//Used to the brush of dottedline
-function CreatePatternBrush(_para1:HBITMAP):HBRUSH;
-var
-  ALog: TLogBrush;
-begin
-  Logger.AddCheckPoint(lcDummyFunctions,'CreatePatternBrush');
-  //lcl_todo
-  with ALog do
-  begin
-    lbStyle:=0;
-    lbColor:=0;
-    lbHatch:=0;
-  end;
-  Result:=CreateBrushIndirect(ALog);
-end;
-
-function GetBkColor(_para1:HDC):COLORREF;
-begin
-  Logger.AddCheckPoint(lcDummyFunctions,'GetBkColor');
-end;
-
-
-function ImageList_DragShowNolock(fShow:Boolean): Boolean;
-begin
-  Logger.AddCheckPoint(lcDummyFunctions,'ImageList_DragShowNoLock');
-end;
-
-function GetKeyboardState(lpKeyState:PBYTE):Boolean;
-begin
-  Logger.AddCheckPoint(lcDummyFunctions,'GetKeyboardState');
-end;
-
-function ToAscii(uVirtKey:UINT; uScanCode:UINT; lpKeyState:PBYTE;
-  lpChar: PChar; uFlags:UINT):longint;
-begin
-  Logger.AddCheckPoint(lcDummyFunctions,'ToAscii');
-end;
-
-function SystemParametersInfo(uiAction:UINT; uiParam:UINT;
-   pvParam:Pointer; fWinIni:UINT):Boolean;
-begin
-  Logger.AddCheckPoint(lcDummyFunctions,'SystemParameterInfo');
-end;
-
-function SetTimer(hWnd:HWND; nIDEvent:UINT; uElapse:UINT; lpTimerFunc:Pointer):UINT;
-begin
-  Logger.AddCheckPoint(lcDummyFunctions,'SetTimer');
-end;
-
-function SubtractRect(lprcDst:TRECT; lprcSrc1:TRECT; lprcSrc2:TRECT):Boolean;
-begin
-  Logger.AddCheckPoint(lcDummyFunctions,'SubtractRect');
-end;
-
-function DeferWindowPos(hWinPosInfo:THandle; hWnd:THandle; hWndInsertAfter:THandle;
-  x:longint; y:longint;cx:longint; cy:longint; uFlags:UINT):THandle;
-begin
-  Logger.AddCheckPoint(lcDummyFunctions,'DeferWindowPos');
-end;
-
-function BeginDeferWindowPos(nNumWindows:longint):THandle;
-begin
-  Logger.AddCheckPoint(lcDummyFunctions,'BeginDeferWindowPos');
-end;
-
-function EndDeferWindowPos(hWinPosInfo:THandle):Boolean;
-begin
-  Logger.AddCheckPoint(lcDummyFunctions,'EndDeferWindowpos');
-end;
-
-function GetLocaleInfo(Locale:DWord; LCType:DWord; lpLCData:PChar; cchData:longint):longint;
-begin
-  Logger.AddCheckPoint(lcDummyFunctions,'GetLocaleInfo');
-end;
-
-function GetACP:UINT;
-begin
-  Logger.AddCheckPoint(lcDummyFunctions,'GetACP');
-end;
-
-function MultiByteToWideChar(CodePage:UINT; dwFlags:DWORD; lpMultiByteStr:PChar;
-  cchMultiByte:longint; lpWideCharStr:PWideChar; cchWideChar:longint):longint;
-begin
-  Logger.AddCheckPoint(lcDummyFunctions,'MultiByteToWideChar');
-end;
-
-function GetKeyboardLayout(dwLayout:DWORD):THandle;
-begin
-  Logger.AddCheckPoint(lcDummyFunctions,'GetKeyboardLayout');
-end;
-
-function DefWindowProc(hWnd:HWND; Msg:UINT; wParam:WPARAM; lParam:LPARAM):LRESULT;
-begin
-  Logger.AddCheckPoint(lcDummyFunctions,'DefWindowProc');
-end;
-
-function GetDCEx(hWnd:HWND; hrgnClip:HRGN; flags:DWORD):HDC;
-begin
-  Logger.AddCheckPoint(lcDummyFunctions,'GetDCEx');
-end;
-
-function OffsetRgn(_para1:HRGN; _para2:longint; _para3:longint):longint;
-begin
-  Logger.AddCheckPoint(lcDummyFunctions,'OffsetRegion');
-end;
-
-function SetBrushOrgEx(_para1:HDC; _para2:longint; _para3:longint; _para4:PPOINT):Boolean;
-begin
-  Logger.AddCheckPoint(lcDummyFunctions,'SetBrushOrgEx');
-end;
-
-{$endif}
 
 {$ifndef UseExternalDragManager}
 function RegisterDragDrop(hwnd:HWND; pDropTarget:IDropTarget):WINOLEAPI;stdcall;external 'ole32.dll' name 'RegisterDragDrop';

components/virtualtreeview-unstable/port.log

@@ -91,7 +91,14 @@ Port started in 26/01/07
 * Fixed drawing problem when using ScrollBar or MouseWheel
 * Implemented Support for check images
 * Fixed position of editors while scrolling
-* Started header implementation
+* Header implementation
+* Started handling of Header messages
+* Made TVTHeaderPopupMenu.Popup virtual
+* Added woekaround to drawing when scrolling
+* Implemented column resize
+* Implemented SetTimer/KillTimer
+* Fixed column position
+* Removed direct dependency from ActiveX, Oleutils
 
 #Major Tasks#
 < > General Painting
@@ -168,7 +175,7 @@ Port started in 26/01/07
   [*] AFAIK yes
 < > See if Application.ProcessMessages in InterruptValidation will work (WM_QUIT handling??)
 <*> See if windows.GetUpdateRect is equal to PaintStruct in WM Paint
-  [*] Yes and no. The values of GetUpdateRect and rcPaint is equal in most times. So is safe to use it
+  [*] Yes and no. The values of GetUpdateRect and rcPaint are equal in most times. So is safe to use it
       But GetUpdateRect will always return an empty Rect when called inside LM_PAINT because there's a
       prior BeginPaint call
 < > In TWMKillfocus the code to nullify the active control is probably not necessary
@@ -188,3 +195,4 @@ Port started in 26/01/07
 < > Document Differences between WMPaint
 < > Document that ScrollWindow does not exists in gtk
 < > Due to lclheader implementation, when a editor is scrolled out of the window it disppears (does not returns when scroled back)
+< > Document differences of DrawFrameControl, ScrollWindow, InvalidateRect

components/virtualtreeview-unstable/units/win32/virtualdragmanager.pas

@@ -177,6 +177,12 @@ type
     function QueryContinueDrag(EscapePressed: BOOL; KeyState: Integer): HResult; stdcall;
   end;
   
+  //Ole helper functions
+
+  function Succeeded(Status : HRESULT) : BOOLEAN;
+
+  function Failed(Status : HRESULT) : BOOLEAN;
+  
   //ActiveX functions that have wrong calling convention in fpc
   
   function RegisterDragDrop(hwnd:HWND; pDropTarget:IDropTarget):WINOLEAPI;stdcall;external 'ole32.dll' name 'RegisterDragDrop';
@@ -211,6 +217,8 @@ type
   function GetStreamFromMedium(Medium:TStgMedium):TStream;
   
   procedure UnlockMediumData(Medium:TStgMedium);
+  
+  function GetTreeFromDataObject(const DataObject: IDataObject; var Format: TFormatEtc): TObject;
 
 implementation
 
@@ -221,6 +229,17 @@ type
   TVirtualTreeAccess = class (TBaseVirtualTree)
   end;
 
+function Succeeded(Status : HRESULT) : BOOL;
+  begin
+     Succeeded:=Status and HRESULT($80000000)=0;
+  end;
+
+function Failed(Status : HRESULT) : BOOL;
+  begin
+     Failed:=Status and HRESULT($80000000)<>0;
+  end;
+
+
 function RenderOLEData(Tree: TObject; const FormatEtcIn: TFormatEtc; out
   Medium: TStgMedium; ForClipboard: Boolean): HResult;
 
@@ -353,6 +372,32 @@ begin
     GlobalUnlock(Medium.hGlobal);
 end;
 
+function GetTreeFromDataObject(const DataObject: IDataObject;
+  var Format: TFormatEtc): TObject;
+  
+var
+  Medium: TStgMedium;
+  Data: PVTReference;
+  
+begin
+  Result := nil;
+  if Assigned(DataObject) then
+  begin
+    Format.cfFormat := CF_VTREFERENCE;
+    if DataObject.GetData(Format, Medium) = S_OK then
+    begin
+      Data := GlobalLock(Medium.hGlobal);
+      if Assigned(Data) then
+      begin
+        if Data.Process = GetCurrentProcessID then
+          Result := Data.Tree;
+        GlobalUnlock(Medium.hGlobal);
+      end;
+      ReleaseStgMedium(@Medium);
+    end;
+  end;
+end;
+
 //----------------------------------------------------------------------------------------------------------------------
 
 // OLE drag and drop support classes