pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

Fixed drawing problem when using scrollbars or mouse wheel

Browse Source 
Implemented checkbuttons

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@57 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
blikblum
2007-02-19 01:02:31 +00:00
parent 4d30d1b397
commit 522da1e090
9 changed files with 182 additions and 120 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
components/virtualtreeview/VTConfig.inc
View File

@ -29,6 +29,7 @@
{.$define EnableNativeTVM}
{.$define EnablePrint}
{$define NeedWindows}
{$define EnableNCFunctions}
{.$define EnableAdvancedGraphics}
{.$define EnableHeader}
{.$define EnableTimer}

231
components/virtualtreeview/VirtualTrees.pas
View File

@ -81,6 +81,8 @@ unit VirtualTrees;
// Subversion (server), TortoiseSVN (client tools), Fisheye (Web interface)
// Accessability implementation:
// Marco Zehe (with help from Sebastian Modersohn)
// LCL Port (version 4.5.1):
// Luiz Américo Pereira Câmara
//----------------------------------------------------------------------------------------------------------------------
interface
@ -3359,6 +3361,7 @@ const
Copyright: string = 'Virtual Treeview © 1999, 2003 Mike Lischke';
var
StandardOLEFormat: TFormatEtc = (
// Format must later be set.
cfFormat: 0;
@ -4721,7 +4724,7 @@ const
Grays: array[0..3] of TColor = (clWhite, clSilver, clGray, clBlack);
SysGrays: array[0..3] of TColor = (clWindow, clBtnFace, clBtnShadow, clBtnText);
//todo_lcl_block
{
procedure ConvertImageList(IL: TImageList; const ImageName: string; ColorRemapping: Boolean = True);
// Loads a bunch of images given by ImageName into IL. If ColorRemapping = True then a mapping of gray values to
@ -4729,23 +4732,31 @@ procedure ConvertImageList(IL: TImageList; const ImageName: string; ColorRemappi
var
Images,
OneImage: TBitmap;
OneImage,
AnotherImage: TBitmap;
I: Integer;
MaskColor: TColor;
Source,
Dest: TRect;
//Small (???) hack while a solution does not come
Stream: TMemoryStream;
begin
Watcher.Enter;
try
// Since we want the image list appearing in the correct system colors, we have to remap its colors.
Images := TBitmap.Create;
OneImage := TBitmap.Create;
//OneImage := TBitmap.Create;
//todo: remove this ugly hack ASAP
Stream:=TMemoryStream.Create;
//todo: see what CreateMappedRes do and replace it
{
if ColorRemapping then
Images.Handle := CreateMappedRes(FindClassHInstance(TBaseVirtualTree), PChar(ImageName), Grays, SysGrays)
else
Images.Handle := LoadBitmap(FindClassHInstance(TBaseVirtualTree), PChar(ImageName));
}
Images.LoadFromLazarusResource(ImageName);
Logger.SendBitmap(lcCheck,ImageName,Images);
try
Assert(Images.Height > 0, 'Internal image "' + ImageName + '" is missing or corrupt.');
@ -4753,20 +4764,34 @@ begin
IL.Clear;
IL.Height := Images.Height;
IL.Width := Images.Height;
OneImage.Width := IL.Width;
OneImage.Height := IL.Height;
MaskColor := Images.Canvas.Pixels[0, 0]; // this is usually clFuchsia
//OneImage.Width := IL.Width;
//OneImage.Height := IL.Height;
MaskColor := clFuchsia;//Images.Canvas.Pixels[0, 0]; // this is usually clFuchsia
Dest := Rect(0, 0, IL.Width, IL.Height);
for I := 0 to (Images.Width div Images.Height) - 1 do
begin
Source := Rect(I * IL.Width, 0, (I + 1) * IL.Width, IL.Height);
OneImage:= TBitmap.Create;
OneImage.Width:=IL.Height;
OneImage.Height:=IL.Width;
OneImage.Canvas.CopyRect(Dest, Images.Canvas, Source);
IL.AddMasked(OneImage, MaskColor);
//somehow SaveToStream - LoadFromStream restores the tranparency lost in CopyRect
OneImage.SaveToStream(Stream);
OneImage.Free;
AnotherImage:=TBitmap.Create;
Stream.Position:=0;
AnotherImage.LoadFromStream(Stream);
Stream.Size:=0;
Logger.SendBitmap(lcCheck,'AnotherImage - '+IntToStr(i),AnotherImage);
IL.AddDirect(AnotherImage, nil);
end;
finally
Images.Free;
OneImage.Free;
//OneImage.Free;
Stream.Free;
end;
Logger.Send(lcCheck,'IL.Count',IL.Count);
finally
Watcher.Leave;
end;
@ -4806,7 +4831,8 @@ var
FlatImages.Draw(BM.Canvas, OffsetX, OffsetY, I)
else
DarkCheckImages.Draw(BM.Canvas, OffsetX, OffsetY, I);
IL.AddMasked(BM, MaskColor);
//IL.AddMasked(BM, MaskColor);
IL.AddCopy(BM,nil);
end;
end;
@ -4842,8 +4868,10 @@ var
ButtonState := ButtonState or DFCS_CHECKED;
if Flat then
ButtonState := ButtonState or DFCS_FLAT;
DrawFrameControl(BM.Canvas.Handle, Rect(1, 2, BM.Width - 2, BM.Height - 1), DFC_BUTTON, ButtonType or ButtonState);
IL.AddMasked(BM, MaskColor);
//todo: remap to LCLIntf
Windows.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;
//--------------- end local functions ---------------------------------------
@ -4855,10 +4883,11 @@ begin
Width := GetSystemMetrics(SM_CXMENUCHECK) + 3;
Height := GetSystemMetrics(SM_CYMENUCHECK) + 3;
IL := TImageList.CreateSize(Width, Height);
with IL do
Handle := ImageList_Create(Width, Height, Flags, 0, AllocBy);
//with IL do
// Handle := ImageList_Create(Width, Height, Flags, 0, AllocBy);
IL.Masked := True;
IL.BkColor := clWhite;
//todo: see why compiler complain here
//IL.BkColor := clWhite;
// Create a temporary bitmap, which holds the intermediate images.
BM := TBitmap.Create;
@ -4869,7 +4898,8 @@ begin
BM.Canvas.Brush.Color := MaskColor;
BM.Canvas.Brush.Style := bsSolid;
BM.Canvas.FillRect(Rect(0, 0, BM.Width, BM.Height));
IL.AddMasked(BM, MaskColor);
//IL.AddMasked(BM, MaskColor);
IL.AddCopy(BM,nil);
// Add the 20 system checkbox and radiobutton images.
for I := 0 to 19 do
@ -4878,10 +4908,12 @@ begin
AddNodeImages(IL);
finally
BM.Free;
//todo: change to except??
//lcl free the bitmap in IL
//BM.Free;
end;
end;
}
//----------------------------------------------------------------------------------------------------------------------
function HasMMX: Boolean;
@ -4980,7 +5012,7 @@ begin
{$ifdef EnableOLE}
// Initialize OLE subsystem for drag'n drop and clipboard operations.
//todo: replace by Suceeded (see in windows)
//todo: replace by Suceeded (see in windows unit)
NeedToUnitialize := OleInitialize(nil) in [S_FALSE,S_OK];
{$endif}
// Register the tree reference clipboard format. Others will be handled in InternalClipboarFormats.
@ -4989,49 +5021,49 @@ 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_lcl_block
{
if IsWinNT then
Flags := ILC_COLOR32 or ILC_MASK
else
Flags := ILC_COLOR16 or ILC_MASK;
LightCheckImages := TImageList.Create(nil);
with LightCheckImages do
Handle := ImageList_Create(16, 16, Flags, 0, AllocBy);
LightCheckImages := TImageList.CreateSize(16,16);
//with LightCheckImages do
// Handle := ImageList_Create(16, 16, Flags, 0, AllocBy);
ConvertImageList(LightCheckImages, 'VT_CHECK_LIGHT');
DarkCheckImages := TImageList.CreateSize(16, 16);
with DarkCheckImages do
Handle := ImageList_Create(16, 16, Flags, 0, AllocBy);
//with DarkCheckImages do
// Handle := ImageList_Create(16, 16, Flags, 0, AllocBy);
ConvertImageList(DarkCheckImages, 'VT_CHECK_DARK');
LightTickImages := TImageList.CreateSize(16, 16);
with LightTickImages do
Handle := ImageList_Create(16, 16, Flags, 0, AllocBy);
//with LightTickImages do
// Handle := ImageList_Create(16, 16, Flags, 0, AllocBy);
ConvertImageList(LightTickImages, 'VT_TICK_LIGHT');
DarkTickImages := TImageList.CreateSize(16, 16);
with DarkTickImages do
Handle := ImageList_Create(16, 16, Flags, 0, AllocBy);
//with DarkTickImages do
// Handle := ImageList_Create(16, 16, Flags, 0, AllocBy);
ConvertImageList(DarkTickImages, 'VT_TICK_DARK');
FlatImages := TImageList.CreateSize(16, 16);
with FlatImages do
Handle := ImageList_Create(16, 16, Flags, 0, AllocBy);
//with FlatImages do
// Handle := ImageList_Create(16, 16, Flags, 0, AllocBy);
ConvertImageList(FlatImages, 'VT_FLAT');
XPImages := TImageList.CreateSize(16, 16);
with XPImages do
Handle := ImageList_Create(16, 16, Flags, 0, AllocBy);
//with XPImages do
// Handle := ImageList_Create(16, 16, Flags, 0, AllocBy);
ConvertImageList(XPImages, 'VT_XP', False);
UtilityImages := TImageList.CreateSize(UtilityImageSize, UtilityImageSize);
with UtilityImages do
Handle := ImageList_Create(UtilityImageSize, UtilityImageSize, Flags, 0, AllocBy);
//with UtilityImages do
// Handle := ImageList_Create(UtilityImageSize, UtilityImageSize, Flags, 0, AllocBy);
ConvertImageList(UtilityImages, 'VT_UTILITIES');
CreateSystemImageSet(SystemCheckImages, Flags, False);
CreateSystemImageSet(SystemFlatCheckImages, Flags, True);
}
// Specify an useful timer resolution for timeGetTime.
timeBeginPeriod(MinimumTimerInterval);
@ -12435,7 +12467,7 @@ var
Offset: TPoint;
begin
Logger.EnterMethod(lcPaint,'ClearNodeBackground');
Logger.EnterMethod(lcPaintDetails,'ClearNodeBackground');
with PaintInfo do
begin
EraseAction := eaDefault;
@ -12474,7 +12506,7 @@ begin
if (poDrawSelection in PaintOptions) and (toFullRowSelect in FOptions.FSelectionOptions) and
(vsSelected in Node.States) and not (toUseBlendedSelection in FOptions.PaintOptions) then
begin
Logger.Send(lcPaint,'Setting the color of a selected node');
Logger.Send(lcPaintDetails,'Setting the color of a selected node');
if toShowHorzGridLines in FOptions.PaintOptions then
Dec(R.Bottom);
if Focused or (toPopupMode in FOptions.FPaintOptions) then
@ -12494,7 +12526,7 @@ begin
else
begin
Brush.Color := Self.Color;
Logger.Send(lcPaint,'Setting the color of a NOT selected node - Brush.Color',Brush.Color);
Logger.Send(lcPaintDetails,'Setting the color of a NOT selected node - Brush.Color',Brush.Color);
FillRect(R);
end;
end;
@ -12502,7 +12534,7 @@ begin
DoAfterItemErase(Canvas, Node, R);
end;
end;
Logger.ExitMethod(lcPaint,'ClearNodeBackground');
Logger.ExitMethod(lcPaintDetails,'ClearNodeBackground');
end;
//----------------------------------------------------------------------------------------------------------------------
@ -15005,7 +15037,7 @@ begin
if toAutoBidiColumnOrdering in FOptions.FAutoOptions then
FHeader.FColumns.ReorderColumns(UseRightToLeftAlignment);
FHeader.Invalidate(nil);
Logger.Send(lcPaint,'FEffectiveOffsetX after CMBidiModeChanged',FEffectiveOffsetX);
Logger.Send(lcPaintDetails,'FEffectiveOffsetX after CMBidiModeChanged',FEffectiveOffsetX);
end;
//----------------------------------------------------------------------------------------------------------------------
@ -15790,10 +15822,14 @@ end;
//----------------------------------------------------------------------------------------------------------------------
procedure TBaseVirtualTree.WMEraseBkgnd(var Message: TLMEraseBkgnd);
var
R: TRect;
begin
Logger.Send(lcMessages,'WMEraseBkgnd - (Does nothing Set to 1)');
Logger.EnterMethod(lcPaint,'WMEraseBkgnd');
Windows.GetUpdateRect(Handle,R,True);
Logger.Send(lcPaint,'UpdateRect',R);
Message.Result := 1;
Logger.ExitMethod(lcPaint,'WMEraseBkgnd');
end;
//----------------------------------------------------------------------------------------------------------------------
@ -16831,14 +16867,19 @@ procedure TBaseVirtualTree.WMPaint(var Message: TLMPaint);
begin
Logger.EnterMethod(lcMessages,'WMPaint');
//todo_lcl_check see if windows.GetUpdateRect is equal to PaintStruct
//todo:
//Windows.GetUpdateRect is always empty because BeginPaint was called
//see if PaintStruct has the same rect
if tsVCLDragging in FStates then
ImageList_DragShowNolock(False);
if csPaintCopy in ControlState then
FUpdateRect := ClientRect
else
FUpdateRect:=Message.PaintStruct^.rcPaint;
//Windows.GetUpdateRect(Handle,FUpdateRect,True);
Logger.Send(lcPaint,'FUpdateRect', FUpdateRect);
inherited WMPaint(Message);
if tsVCLDragging in FStates then
@ -22248,7 +22289,7 @@ begin
// The clipping rectangle is given in client coordinates of the window. We have to convert it into
// a sliding window of the tree image.
Logger.Send(lcPaint,'FEffectiveOffsetX: %d, RTLOffset: %d, OffsetY: %d',[FEffectiveOffsetX,RTLOffset,FOffsetY]);
Logger.Send(lcPaintDetails,'FEffectiveOffsetX: %d, RTLOffset: %d, OffsetY: %d',[FEffectiveOffsetX,RTLOffset,FOffsetY]);
//Logger.Send(lcPaint,'Window Before Offset',Window);
Windows.OffsetRect(Window, FEffectiveOffsetX - RTLOffset, -FOffsetY);
//Logger.Send(lcPaint,'Window After Offset',Window);
@ -22256,6 +22297,7 @@ begin
end
else
begin
Logger.Send(lcPaint,'FUpdateRect IS Empty');
// First part, fixed columns
Window := ClientRect;
Window.Right := Temp;
@ -22268,7 +22310,10 @@ begin
Window := GetClientRect;
if Temp > Window.Right then
begin
Logger.ExitMethod(lcPaint,'Paint');
Exit;
end;
Window.Left := Temp;
Target := Window.TopLeft;
@ -22292,6 +22337,7 @@ var
{$endif ThemeSupport}
begin
Logger.EnterMethod(lcCheck,'PaintCheckImage');
with PaintInfo, ImageInfo[iiCheck] do
begin
{$ifdef ThemeSupport}
@ -22337,10 +22383,12 @@ begin
else
ForegroundColor := GetRGBColor(BlendColor);
ImageList_DrawEx(Handle, Index, Canvas.Handle, XPos, YPos, 0, 0, GetRGBColor(BkColor), ForegroundColor,
ILD_TRANSPARENT);
Draw(Canvas,XPos,YPos,Index);
//ImageList_DrawEx(Handle, Index, Canvas.Handle, XPos, YPos, 0, 0, GetRGBColor(BkColor), ForegroundColor,
// ILD_TRANSPARENT);
end;
end;
Logger.ExitMethod(lcCheck,'PaintCheckImage');
end;
//----------------------------------------------------------------------------------------------------------------------
@ -22434,7 +22482,7 @@ var
XPos: Integer;
begin
Logger.EnterMethod(lcPaint,'PaintNodeButton');
Logger.EnterMethod(lcPaintDetails,'PaintNodeButton');
if vsExpanded in Node.States then
Bitmap := FMinusBM
else
@ -22448,7 +22496,7 @@ begin
Logger.SendBitmap(lcPaintBitmap,'NodeButton',Bitmap);
// Need to draw this masked.
Canvas.Draw(XPos, R.Top + ButtonY, Bitmap);
Logger.ExitMethod(lcPaint,'PaintNodeButton');
Logger.ExitMethod(lcPaintDetails,'PaintNodeButton');
end;
//----------------------------------------------------------------------------------------------------------------------
@ -22463,7 +22511,7 @@ var
NewStyles: TLineImage;
begin
Logger.EnterMethod(lcPaint,'PaintTreeLines');
Logger.EnterMethod(lcPaintDetails,'PaintTreeLines');
NewStyles := nil;
with PaintInfo do
@ -22487,7 +22535,7 @@ begin
SetLength(NewStyles, Length(LineImage));
for I := IndentSize - 1 downto 0 do
begin
Logger.Send(lcPaint,'FLineMode = lmBands');
Logger.Send(lcPaintDetails,'FLineMode = lmBands');
if (vsExpanded in Node.States) and not (vsAllChildrenHidden in Node.States) then
NewStyles[I] := ltLeft
else
@ -22523,10 +22571,10 @@ begin
end;
end;
else // lmNormal
Logger.Send(lcPaint,'FLineMode = lmNormal');
Logger.Send(lcPaint,'Brush.Color',PaintInfo.Canvas.Brush.Color);
Logger.Send(lcPaintDetails,'FLineMode = lmNormal');
Logger.Send(lcPaintDetails,'Brush.Color',PaintInfo.Canvas.Brush.Color);
PaintInfo.Canvas.Font.Color := FColors.TreeLineColor;
Logger.Send(lcPaint,'Brush.Color',PaintInfo.Canvas.Font.Color);
Logger.Send(lcPaintDetails,'Brush.Color',PaintInfo.Canvas.Font.Color);
for I := 0 to IndentSize - 1 do
begin
DrawLineImage(PaintInfo, XPos, CellRect.Top, NodeHeight[Node], VAlignment, LineImage[I],
@ -22535,7 +22583,7 @@ begin
end;
end;
end;
Logger.ExitMethod(lcPaint,'PaintTreeLines');
Logger.ExitMethod(lcPaintDetails,'PaintTreeLines');
end;
//----------------------------------------------------------------------------------------------------------------------
@ -27354,12 +27402,12 @@ begin
PaintInfo.Canvas := NodeBitmap.Canvas;
NodeBitmap.Canvas.Lock;
try
Logger.Send(lcPaint,'FNewSelRect',FNewSelRect);
Logger.Send(lcPaintDetails,'FNewSelRect',FNewSelRect);
// Prepare the current selection rectangle once. The corner points are absolute tree coordinates.
SelectionRect := OrderRect(FNewSelRect);
Logger.Send(lcPaint,'SelectionRect',SelectionRect);
Logger.Send(lcPaintDetails,'SelectionRect',SelectionRect);
DrawSelectionRect := IsMouseSelecting and not IsRectEmpty(SelectionRect);
Logger.Watch(lcPaint,'DrawSelectionRect',DrawSelectionRect);
Logger.Watch(lcPaintDetails,'DrawSelectionRect',DrawSelectionRect);
// R represents an entire node (all columns), but is a bit unprecise when it comes to
// trees without any column defined, because FRangeX only represents the maximum width of all
// nodes in the client area (not all defined nodes). There might be, however, wider nodes somewhere. Without full
@ -27367,7 +27415,7 @@ begin
// that the tree is fully displayed on screen.
R := Rect(0, 0, Max(FRangeX, ClientWidth), 0);
NodeBitmap.Width := Window.Right - Window.Left;
Logger.Send(lcPaint,'NodeBitmap.Width',NodeBitmap.Width);
Logger.Send(lcPaintDetails,'NodeBitmap.Width',NodeBitmap.Width);
// Make sure the buffer bitmap and target bitmap use the same transformation mode.
SetMapMode(NodeBitmap.Canvas.Handle, GetMapMode(TargetCanvas.Handle));
@ -27377,6 +27425,7 @@ begin
ShowImages := Assigned(FImages);
ShowStateImages := Assigned(FStateImages);
ShowCheckImages := Assigned(FCheckImages) and (toCheckSupport in FOptions.FMiscOptions);
Logger.Send(lcCheck,'ShowCheckImages',ShowCheckImages);
UseColumns := FHeader.UseColumns;
// Adjust paint options to tree settings. Hide selection if told so or the tree is unfocused.
@ -27419,9 +27468,9 @@ begin
// ----- main node paint loop
while Assigned(PaintInfo.Node) do
begin
Logger.EnterMethod(lcPaint,'PaintNode');
Logger.Watch(lcPaint,'BaseOffset',BaseOffset);
Logger.Watch(lcPaint,'Brush.Color',PaintInfo.Canvas.Brush.Color);
Logger.EnterMethod(lcPaintDetails,'PaintNode');
Logger.Watch(lcPaintDetails,'BaseOffset',BaseOffset);
Logger.Watch(lcPaintDetails,'Brush.Color',PaintInfo.Canvas.Brush.Color);
// Initialize node if not already done.
if not (vsInitialized in PaintInfo.Node.States) then
InitNode(PaintInfo.Node);
@ -27464,11 +27513,11 @@ begin
begin
// Init paint options for the background painting.
PaintInfo.PaintOptions := PaintOptions;
Logger.Watch(lcPaint,'Brush.Color',PaintInfo.Canvas.Brush.Color);
Logger.Watch(lcPaintDetails,'Brush.Color',PaintInfo.Canvas.Brush.Color);
// The node background can contain a single color, a bitmap or can be drawn by the application.
ClearNodeBackground(PaintInfo, UseBackground, True, Rect(Window.Left, TargetRect.Top, Window.Right,
TargetRect.Bottom));
Logger.Watch(lcPaint,'Brush.Color',PaintInfo.Canvas.Brush.Color);
Logger.Watch(lcPaintDetails,'Brush.Color',PaintInfo.Canvas.Brush.Color);
// Prepare column, position and node clipping rectangle.
PaintInfo.CellRect := R;
if UseColumns then
@ -27480,7 +27529,7 @@ begin
while ((PaintInfo.Column > InvalidColumn) or not UseColumns)
and (PaintInfo.CellRect.Left < Window.Right) do
begin
Logger.Send(lcPaint,'Handling a column');
Logger.Send(lcPaintDetails,'Handling a column');
if UseColumns then
begin
PaintInfo.Column := FPositionToIndex[PaintInfo.Position];
@ -27613,7 +27662,7 @@ begin
// Prepare background and focus rect for the current cell.
PrepareCell(PaintInfo, Window.Left, NodeBitmap.Width);
Logger.Watch(lcPaint,'Brush.Color',PaintInfo.Canvas.Brush.Color);
Logger.Watch(lcPaintDetails,'Brush.Color',PaintInfo.Canvas.Brush.Color);
// Some parts are only drawn for the main column.
if IsMainColumn then
begin
@ -27629,18 +27678,18 @@ begin
if ImageInfo[iiCheck].Index > -1 then
PaintCheckImage(PaintInfo);
end;
Logger.Watch(lcPaint,'Brush.Color',PaintInfo.Canvas.Brush.Color);
Logger.Watch(lcPaintDetails,'Brush.Color',PaintInfo.Canvas.Brush.Color);
if ImageInfo[iiState].Index > -1 then
PaintImage(PaintInfo, iiState, False);
if ImageInfo[iiNormal].Index > -1 then
PaintImage(PaintInfo, iiNormal, True);
Logger.Watch(lcPaint,'Brush.Color',PaintInfo.Canvas.Brush.Color);
Logger.Watch(lcPaintDetails,'Brush.Color',PaintInfo.Canvas.Brush.Color);
// Now let descendants or applications draw whatever they want,
// but don't draw the node if it is currently being edited.
if not ((tsEditing in FStates) and (Node = FFocusedNode) and
((Column = FEditColumn) or not UseColumns)) then
DoPaintNode(PaintInfo);
Logger.Watch(lcPaint,'Brush.Color',PaintInfo.Canvas.Brush.Color);
Logger.Watch(lcPaintDetails,'Brush.Color',PaintInfo.Canvas.Brush.Color);
DoAfterCellPaint(Canvas, Node, Column, CellRect);
end;
end;
@ -27755,29 +27804,29 @@ begin
end;
PaintInfo.Node := Temp;
Logger.ExitMethod(lcPaint,'PaintNode');
Logger.ExitMethod(lcPaintDetails,'PaintNode');
end;
end;
// Erase rest of window not covered by a node.
if TargetRect.Top < MaximumBottom then
begin
Logger.Watch(lcPaint,'UseBackground',UseBackground);
Logger.Watch(lcPaint,'UseColumns',UseColumns);
Logger.Watch(lcPaintDetails,'UseBackground',UseBackground);
Logger.Watch(lcPaintDetails,'UseColumns',UseColumns);
// Keep the horizontal target position to determine the selection rectangle offset later (if necessary).
BaseOffset := Target.X;
Target := TargetRect.TopLeft;
R := Rect(TargetRect.Left, 0, TargetRect.Left, MaximumBottom - Target.Y);
TargetRect := Rect(0, 0, MaximumRight - Target.X, MaximumBottom - Target.Y);
Logger.Send(lcPaint,'NodeBitmap.Handle',NodeBitmap.Handle);
Logger.Send(lcPaintDetails,'NodeBitmap.Handle',NodeBitmap.Handle);
// Avoid unnecessary copying of bitmap content. This will destroy the DC handle too.
NodeBitmap.Height := 0;
NodeBitmap.PixelFormat := pf32Bit;
NodeBitmap.Width := TargetRect.Right - TargetRect.Left + 1;
NodeBitmap.Height := TargetRect.Bottom - TargetRect.Top + 1;
Logger.Send(lcPaint,'NodeBitmap.Handle',NodeBitmap.Handle);
Logger.Send(lcPaint,'TargetRect',TargetRect);
Logger.Send(lcPaint,'NodeBitmap Width: %d Height: %d',[NodeBitmap.Width,NodeBitmap.Height]);
Logger.Send(lcPaintDetails,'NodeBitmap.Handle',NodeBitmap.Handle);
Logger.Send(lcPaintDetails,'TargetRect',TargetRect);
Logger.Send(lcPaintDetails,'NodeBitmap Width: %d Height: %d',[NodeBitmap.Width,NodeBitmap.Height]);
// Call back application/descendants whether they want to erase this area.
SetWindowOrgEx(NodeBitmap.Canvas.Handle, Target.X, 0, nil);
if not DoPaintBackground(NodeBitmap.Canvas, TargetRect) then
@ -27862,8 +27911,8 @@ begin
end
else
begin
Logger.Send(lcPaint,'ErasingBackGround');
Logger.Send(lcPaint,'TargetRect',TargetRect);
Logger.Send(lcPaintDetails,'ErasingBackGround');
Logger.Send(lcPaintDetails,'TargetRect',TargetRect);
// No columns nor bitmap background. Simply erase it with the tree color.
SetWindowOrgEx(NodeBitmap.Canvas.Handle, 0, 0, nil);
NodeBitmap.Canvas.Brush.Color := Color;
@ -27872,7 +27921,7 @@ begin
end;
end;
SetWindowOrgEx(NodeBitmap.Canvas.Handle, 0, 0, nil);
Logger.Watch(lcPaint,'DrawSelectionRect',DrawSelectionRect);
Logger.Watch(lcPaintDetails,'DrawSelectionRect',DrawSelectionRect);
if DrawSelectionRect then
begin
R := OrderRect(FNewSelRect);
@ -27882,9 +27931,9 @@ begin
SetBrushOrgEx(NodeBitmap.Canvas.Handle, 0, Target.X and 1, nil);
PaintSelectionRectangle(NodeBitmap.Canvas, 0, R, TargetRect);
end;
Logger.Send(lcPaint,'NodeBitmap.Canvas.Height',NodeBitmap.Canvas.Height);
Logger.Send(lcPaint,'NodeBitmap.Canvas.ClipRect',NodeBitmap.Canvas.ClipRect);
Logger.Send(lcPaint,'Target',Target);
Logger.Send(lcPaintDetails,'NodeBitmap.Canvas.Height',NodeBitmap.Canvas.Height);
Logger.Send(lcPaintDetails,'NodeBitmap.Canvas.ClipRect',NodeBitmap.Canvas.ClipRect);
Logger.Send(lcPaintDetails,'Target',Target);
Logger.SendBitmap(lcPaintBitmap,'BackGroundBitmap',NodeBitmap);
with Target, NodeBitmap do
BitBlt(TargetCanvas.Handle, X, Y, Width, Height, Canvas.Handle, 0, 0, SRCCOPY);
@ -29182,7 +29231,7 @@ begin
// Reset the current horizontal offset to account for window resize etc.
SetOffsetX(FOffsetX);
end;
Logger.Send(lcPaint,'FEffectiveOffsetX after UpdateHScrollbar',FEffectiveOffsetX);
Logger.Send(lcPaintDetails,'FEffectiveOffsetX after UpdateHScrollbar',FEffectiveOffsetX);
end;
//----------------------------------------------------------------------------------------------------------------------
@ -29933,7 +29982,7 @@ var
Size: TSize;
begin
Logger.EnterMethod(lcPaint,'PaintNormalText') ;
Logger.EnterMethod(lcPaintDetails,'PaintNormalText') ;
InitializeTextProperties(PaintInfo);
with PaintInfo do
begin
@ -29999,10 +30048,10 @@ begin
SetBkMode(Canvas.Handle, TRANSPARENT)
else
SetBkMode(Canvas.Handle, OPAQUE);
Logger.Send(lcPaint,'Canvas.Brush.Color',Canvas.Brush.Color);
Logger.Send(lcPaintDetails,'Canvas.Brush.Color',Canvas.Brush.Color);
DoTextDrawing(PaintInfo, Text, R, DrawFormat);
end;
Logger.ExitMethod(lcPaint,'PaintNormalText');
Logger.ExitMethod(lcPaintDetails,'PaintNormalText');
end;
//----------------------------------------------------------------------------------------------------------------------
@ -30017,7 +30066,7 @@ var
DrawFormat: Cardinal;
begin
Logger.EnterMethod(lcPaint,'PaintStaticText');
Logger.EnterMethod(lcPaintDetails,'PaintStaticText');
with PaintInfo do
begin
Canvas.Font := Font;
@ -30064,7 +30113,7 @@ begin
else
DrawTextW(Canvas.Handle, PWideChar(Text), Length(Text), R, DrawFormat, False);
end;
Logger.ExitMethod(lcPaint,'PaintStaticText');
Logger.ExitMethod(lcPaintDetails,'PaintStaticText');
end;
//----------------------------------------------------------------------------------------------------------------------
@ -30360,7 +30409,7 @@ var
TextOutFlags: Integer;
begin
Logger.EnterMethod(lcPaint,'TCustomVirtualStringTree.DoPaintNode');
Logger.EnterMethod(lcPaintDetails,'TCustomVirtualStringTree.DoPaintNode');
// Set a new OnChange event for the canvas' font so we know if the application changes it in the callbacks.
// This long winded procedure is necessary because font changes (as well as brush and pen changes) are
// unfortunately not announced via the Canvas.OnChange event.
@ -30384,7 +30433,7 @@ begin
PaintStaticText(PaintInfo, TextOutFlags, S);
end;
RestoreFontChangeEvent(PaintInfo.Canvas);
Logger.ExitMethod(lcPaint,'TCustomVirtualStringTree.DoPaintNode');
Logger.ExitMethod(lcPaintDetails,'TCustomVirtualStringTree.DoPaintNode');
end;
//----------------------------------------------------------------------------------------------------------------------

2
components/virtualtreeview/demos/mininal/Main.lrs
View File

@ -1,5 +1,3 @@
{ This is an automatically generated lazarus resource file }
LazarusResources.Add('TMainForm','FORMDATA',[
'TPF0'#9'TMainForm'#8'MainForm'#4'Left'#3'a'#1#6'Height'#3#225#1#3'Top'#3#172
+#0#5'Width'#3#169#1#18'HorzScrollBar.Page'#3#168#1#18'VertScrollBar.Page'#3

2
components/virtualtreeview/demos/mininal/Main.pas
View File

@ -59,7 +59,7 @@ procedure TMainForm.FormCreate(Sender: TObject);
begin
{$ifdef DEBUG}
Logger.ActiveClasses:=[lcScroll];
Logger.ActiveClasses:=[];//[lcScroll,lcPaint];
Logger.Channels.Add(TIPCChannel.Create);
Logger.Clear;
Logger.MaxStackCount:=10;

10
components/virtualtreeview/demos/mininal/minimal_lcl.lpi
View File

@ -63,19 +63,9 @@
<CompilerOptions>
<Version Value="5"/>
<PathDelim Value="\"/>
<SearchPaths>
<OtherUnitFiles Value="E:\subversion\luipack\trunk\virtualtreeview\"/>
</SearchPaths>
<CodeGeneration>
<Generate Value="Faster"/>
</CodeGeneration>
<Linking>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>

11
components/virtualtreeview/lclfunctions.inc
View File

@ -36,6 +36,7 @@ end;
// TBaseVirtualTree.CollectSelectedNodesRTL, TBaseVirtualTree.DetermineHitPositionRTL
// TBaseVirtualTree.UpdateEditBounds, TBaseVirtualTree.GetDisplayRect, PaintTree,
// TStringEditLink.PrepareEdit, TCustomVirtualStringTree.ComputeNodeHeight etc
procedure ChangeBiDiModeAlignment(var Alignment: TAlignment);
begin
case Alignment of
@ -77,6 +78,16 @@ begin
end;
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');
end;
{$ifndef NeedWindows}
//Dummy function. Used in many places

41
components/virtualtreeview/port.log
View File

@ -85,10 +85,11 @@ Port started in 26/01/07
* The TCanvas of VCL does not has width and height as LCL does. This cause conflict with "with" operator
* Implemented TOLEStream
* Fixed bug in LCL.GetScrollPos
* Fixed Draw problems due to TCanvas.Color
* Fixed Draw problems due to TCanvas.Color
* Fixed Align problems of TVirtualNode (Hint from original port)
* Fixed MouseWheel
* Fixed drawing problem when using ScrollBar or MouseWheel
* Implemented Support for check images
#Major Tasks#
< > General Painting
@ -100,8 +101,10 @@ Port started in 26/01/07
[ ] Also maintain OLE ClipBoard?? Necessary??
< > Replace TWMTimer since is only called in win32. Or implement in GTK Intf?
< > Implement Imagelist handling
[ ] See a properly way to setup the ImageLists (avoid current hack)
< > GetCurrentObject used for blending does not exists in LCL. Add it?
[ ] Gtk.GetObject does not return dmBits (is always nil)
[ ] Gtk.GetObject does not return dmBits (is always nil) -> Is not viable to implement
GetObject under Gtk. See another way to do alpha blend (Disable in GTK??)
< > Implement the header
[ ] BevelEdges is used to paint the Header. See if is worth implementing it
[ ] Process the header messages or do another way
@ -110,10 +113,11 @@ Port started in 26/01/07
[ ]Properly Implement TBaseVirtualTree.UseRightToLeftAlignment
#Secondary Tasks#
< > (low) OleAcc: MSAA (Accessibility)
< > WMContextMenu: replace by DoContextPopup??. Add to LCL??
[ ] Fix Double MouseRUp
[ ] in line 2042 of callback simplify
< > pceltFetched in TEnumFormatEtc.Next is declared as ULong in fpc but PLongInt in Delphi
<*> WMContextMenu: replace by DoContextPopup??. Add to LCL??
[*] Fix Double MouseRUp
[*] in line 2042 of callback simplify
<-> pceltFetched in TEnumFormatEtc.Next is declared as ULong in fpc but PLongInt in Delphi
[*] Already reported. No response
< > Implement THintWindow.IsHintMsg ?
< > Add TLMEnable ??
< > Replace WMSetFont since LM_SETFONT is not used in LCL
@ -124,14 +128,15 @@ Port started in 26/01/07
[ ] Replace TVTCriticalSection by SyncObjs.TCriticalSection??
[ ] See appropriate value for INFINITE constant in Linux/BSD etc
< > TWorkerThread.ChangeTreeStates uses SendMessage. See if it works both in win and linux
< > In fpc TStgMedium records have PunkForRelease instead of unkForRelease, same for stm and stg
<-> In fpc TStgMedium records have PunkForRelease instead of unkForRelease, same for stm and stg
[*] Already reported. No response
< > Add a way to replace TBitmap.Scanline and all advanced graphics routines
[ ] Use TLazIntfImage?
[ ] Properly implement CreatePatternBrush or find a way to paint the lines
< > Implement GetBkColor in LCL
< > Begin/EndUpdate uses WM_SETREDRAW message to avoid painting. See a crossplatform way of doing it
<*> Translate MAKEROP4 from C to Pascal. Done copied from fpc
< > TCMMouseWheel is not used in Lazarus. Remove
< > TCMMouseWheel type is not used in Lazarus. Remove
< > Revise CM* functions and messages
< > Implement SubtractRect
< > Implement WMSetFont
@ -144,7 +149,8 @@ Port started in 26/01/07
< > See if getting the length of PWideChar by typecasting to WideString is correct
< > See if the Hint is being show in the correct place
< > See the effect of using RecreateWnd (in TCustomVirtualTreeOptions.SetMiscOptions)
< > WM_NCPAINT: see the behavior under LCL
<*> WM_NCPAINT: see the behavior under LCL
[*] Is not handled. TControl will never receive it
< > TVMGet* functions: probably it can be ignored, since is windows specific and not necessary at all
< > See if WM_COPY can be mapped to LM_COPYTOCLIP
< > See WM_ENABLE,WM_GETDLGCODE behavior under lcl/win32
@ -153,12 +159,16 @@ Port started in 26/01/07
< > TWMPrint and WM_PRINT. See if is necessary
< > In SetCursor uses TLMessage. Investigate
< > See if GetRGBColor is necessary. Probably not. If so remove color constants
< > Found no way to replace ValidateRect in Hint Window animation. See a way to replace it
< > Found no way to replace ValidateRect in Hint Window animation. See how to replace it
< > See if the typecasts to longword in TVirtualTreeColumn.LoadFromStream is correct
< > See te meaning of Bevel* properties see what values it should be in LCL
< > See if MapWindowPoints is returning correct values
< > See te meaning of Bevel* properties. See what values it should be in LCL
<*> See if custom MapWindowPoints is returning correct values
[*] AFAIK yes
< > See if Application.ProcessMessages in InterruptValidation will work (WM_QUIT handling??)
< > see if windows.GetUpdateRect is equal to PaintStruct in WM Paint
<*> 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
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
< > See if DeleteObject is necessary in AdjustCursorPanning
< > See if WHEEL_ constants are valids under gtk
@ -173,4 +183,5 @@ Port started in 26/01/07
< > See code duplicate in TBitmap.SetWidthHeight
< > Document problem of TCanvas.Color
< > Document differences between WMMouseWheel
< > Document Differences between WMPaint
< > Document that ScrollWindow does not exists in gtk

2
components/virtualtreeview/resources/createres.bat
View File

@ -1 +1 @@
lazres ..\virtualtrees.lrs VT_HEADERSPLIT.cur VT_MOVEALL.cur VT_MOVEE.cur VT_MOVEEW.cur VT_MOVEN.cur VT_MOVENE.cur VT_MOVENS.cur VT_MOVENW.cur VT_MOVES.cur VT_MOVESE.cur VT_MOVESW.cur VT_MOVEW.cur VT_XPBUTTONPLUS.bmp VT_XPBUTTONMINUS.bmp
lazres ..\virtualtrees.lrs VT_HEADERSPLIT.cur VT_MOVEALL.cur VT_MOVEE.cur VT_MOVEEW.cur VT_MOVEN.cur VT_MOVENE.cur VT_MOVENS.cur VT_MOVENW.cur VT_MOVES.cur VT_MOVESE.cur VT_MOVESW.cur VT_MOVEW.cur VT_XPBUTTONPLUS.bmp VT_XPBUTTONMINUS.bmp VT_CHECK_LIGHT.bmp VT_CHECK_DARK.bmp VT_FLAT.bmp VT_TICK_DARK.bmp VT_TICK_LIGHT.bmp VT_UTILITIES.bmp VT_XP.bmp

2
components/virtualtreeview/vtlogger.pas
View File

@ -25,6 +25,8 @@ const
lcSetCursor = 10;//it generates a lot of messages. so it will be debugged alone
lcPaintBitmap = 11;
lcScroll = 12;
lcPaintDetails = 13;
lcCheck = 14;
var
Logger: TLCLLogger;