The Virtual Treeview scrolls vertically by pixels, unlike the way the standard Delphi grids, TListView and TTreeView (or most of the other such controls that I am aware of) scroll by line and keep a full line visible at the top of the control at all times. When I use the cursor keys to navigate, then depending on direction either the first or the last line is completely visible. When scrolling with the mouse there is no alignment whatsoever.
This behaviour can be observed for example with the Structure window in Delphi 2007 and 2009.
Is there any way to set the many properties to have the behaviour of the standard windows controls? Or is there a set of patches somewhere to achieve this?
This is what I came up with the help of Argalatyr, looks like it does what I want it to:
procedure TForm1.FormCreate(Sender: TObject);
begin
VirtualStringTree1.ScrollBarOptions.VerticalIncrement :=
VirtualStringTree1.DefaultNodeHeight;
end;
procedure TForm1.VirtualStringTree1Resize(Sender: TObject);
var
DY: integer;
begin
with VirtualStringTree1 do begin
DY := VirtualStringTree1.DefaultNodeHeight;
BottomSpace := ClientHeight mod DY;
VirtualStringTree1.OffsetY := Round(VirtualStringTree1.OffsetY / DY) * DY;
end;
end;
procedure TForm1.VirtualStringTree1Scroll(Sender: TBaseVirtualTree; DeltaX,
DeltaY: Integer);
var
DY: integer;
begin
if DeltaY <> 0 then begin
DY := VirtualStringTree1.DefaultNodeHeight;
VirtualStringTree1.OffsetY := Round(VirtualStringTree1.OffsetY / DY) * DY;
end;
end;
You could intercept the TBaseVirtualTree.OnScroll event and use the virtual treeview's canvas's return value for textheight('M') as the amount to change TBaseVirtualTree.offsety in order to increment (scroll up) or decrement (scroll down). Could also test to ensure that pre-scroll position modulus textheight('M') is zero (to avoid scrolling by the right amount from the wrong position).
Alternatively, this post on the Virtual Treeview forum suggests another approach: hide the virtual treeview's native scroll bars with VCL scroll bars and then do the scrolling yourself (trapping VCL scroll events and programmatically scrolling the virtual treeview).
Related
I am working with this legacy app that has forms having a TScrollBox containing deeply nested TPanel descendents (up to 8 or so levels of nesting), each hosting controls that can cause the panel to be resized to make room for new child panels with their own controls. e.g. the user clicks a radio button, which resizes the panel hosting it to accommodate a new child panel with its own controls, including radio buttons that can cause the child to be resized and repopulated in the same manner.
The performance of this app was good until it was modified to use VCL styles. The group doing that work had to abandon the effort when it was found that the themed version might take over a minute to redraw itself after a single click.
It turned out that enabling double-buffering at the form level worked to make the repainting performance acceptable when the user clicks on a control. Scrolling is still a problem however. The controls on the form are not able to paint themselves fast enough to keep up with a user scrolling by rolling the mouse wheel. The scrollbar gets moved, a part of the client area gets redrawn, then the next mouse wheel message gets processed, a little bit of the client gets redrawn, and so on until the user quits rolling the mouse and there's time to redraw the whole thing. The code that does the scrolling looks like this:
procedure ScrollControl(Window: TScrollingWinControl; ScrollingUp: boolean; Amount: integer = 40);
var
Delta: integer;
// This is needed to tell the child components that they are moving,
// The TORCombo box, for example, needs to close a dropped down window when it moves.
// If Delphi had used standard scroll bars, instead of the customized flat ones, this
// code wouldn't be needed
procedure SendMoveMessage(Ctrl: TWinControl);
var
i: integer;
begin
for i := 0 to Ctrl.ControlCount - 1 do
begin
if Ctrl.Controls[i] is TWinControl then with TWinControl(Ctrl.Controls[i]) do
begin
SendMessage(Handle, WM_MOVE, 0, (Top * 65536) + Left);
SendMoveMessage(TWinControl(Ctrl.Controls[i]));
end;
end;
end;
begin
Delta := Amount;
if ScrollingUp then
begin
if Window.VertScrollBar.Position < Delta then
Delta := Window.VertScrollBar.Position;
Delta := - Delta;
end
else
begin
if (Window.VertScrollBar.Range - Window.VertScrollBar.Position) < Delta then
Delta := Window.VertScrollBar.Range - Window.VertScrollBar.Position;
end;
if Delta <> 0 then
begin
Window.VertScrollBar.Position := Window.VertScrollBar.Position + Delta;
SendMoveMessage(Window);
end;
end;
What I think I want to do is to (right before the outermost call to SendMoveMessage)
make a DC for Window
allocate an offscreen bitmap the size of Window's client area
arrange for all drawing operations on Window and its children to be drawn to the offscreen bitmap
Call SendMoveMessage and
bitblt the offscreen bitmap into Window's client area and free the bitmap and DC.
But I cannot see how to do step 3. Is it even possible?
I have a TDBRadioGroup that I've added to my form.
I'd really like to have the caption to the left of it instead of on top (the form's a little busy and tall, and I'm trying to squeeze it in).
I can add my own label to the left of the Radio Group. But the control insists on reserving space of a Caption that does not exists. Is there a way I can turn it off completely?
The best we've come up with so far is sticking it on a TPanel and then hiding the top couple lines off-panel.
A TGroupBox (and it's descendant TDBGroupBox) are basically wrappers around the Windows GroupBox. The control is designed to sport a user-defined label across the upper-left corner, and doesn't have any style setting to remove it.
So, short of creating your own control to host a series of TRadioButton controls yourself and display them, there's no built-in way to disable the space reserved for the caption. You can suppress the text, of course, by setting the Caption := '', but the padding for the text descenders is not removed simply because the caption isn't displayed.
You can override the paint procedure for TRadioGroup so that the frame is drawn closer to the top of your item list. You could create a new component of type TNoCaptionRadioGroup. You might still have to use the panel trick that you have tried, but by lowering the top of the frame you can grab the space consumed by the non-existent caption. Something like this:
tNoCaptionRadioBox = class(TRadioGroup)
protected
procedure paint; override;
end;
procedure tNoCaptionRadioBox.paint;
var
H: Integer;
R: TRect;
begin
with Canvas do
begin
Font := Self.Font;
H := TextHeight('0');
R := Rect(0, H, Width, Height);
if Ctl3D then
begin
Inc(R.Left);
Inc(R.Top);
Brush.Color := clBtnHighlight;
FrameRect(R);
OffsetRect(R, -1, -1);
Brush.Color := clBtnShadow;
end else
Brush.Color := clWindowFrame;
FrameRect(R);
end;
end;
This is taken from the code for painting a TCustomGroupBox. I have removed the code for drawing the caption and have changed the top of the frame to the full height of the Font. Your actual captioned radio buttons will still be drawn where Windows wants them to be and with the default spacing.
Remember to register the new component by running the package installation tool.
procedure Register;
begin
RegisterComponents('myComponents', [tNoCaptionRadioBox]);
end;
Hi guys after 3 days of not finding the right answer i come to you for help :) , so my question is this i have a TScrollBox component in my form and i create TImage components at FormCreate event this fills up the Scroll-box with components but when i want to scroll through them using Scroll-by it goes way beyond the end of the last component, the code will run on 2 buttons and mouse wheel 1 button left 2 button right and mouse wheel either sides
procedure TForm1.RightButtonClick(Sender: TObject);
var
Coff : Double;
begin
Coff := 6.6;
scrollbarpos := scrollbarpos - 100;
if((scrollbarpos>= -Coff * screen.PixelsPerInch) AND (scrollbarpos<=0)) then
begin
ScrollBox1.ScrollBy(-100,0);
end
else
begin
scrollbarpos := scrollbarpos + 100;
if(scrollbarpos < -(Coff /2) * screen.PixelsPerInch) then
begin
ScrollBox1.ScrollBy(-Round(scrollbarpos+Coff *screen.PixelsPerInch),0);
scrollbarpos := round( -Coff * screen.PixelsPerInch);
end;
end;
end;
this code works but when i change my "Control Panel\Appearance and Personalization\Display" settings from smaller - 100% to medium or large it goes beyond the last component, it has something to do with the Coff value. Any ideas of a more effective way to scroll without using scroll bars because they are invisible.
Project can be found here: http://www.failai.lt/i9famvv1my9f/proj.rar.htm
We have a win control object which moves its clients to some other coordiantes. The problem is, when there are too many children - for example 500 controls - the code is really slow.
It must be because of each control being repainted each time I set Left and Top property. So, I want to tell the WinControl object stop being repainted, and after moving all objects to their new positions, it may be painted again (Something like BeginUpdate for memo and list objects). How can I do this?
Here's the code of moving the objects; it's quite simple:
for I := 0 to Length(Objects) - 1 do begin
with Objects[I].Client do begin
Left := Left + DX;
Top := Top + DY;
end;
end;
As Cosmin Prund explains, the cause for the long duration is not an effect of repainting but of VCL's realignment requisites at control movement. (If it really should take as long as it does, then you might even need to request immediate repaints).
To temporarily prevent realignment and all checks and work for anchors, align settings and Z-order, use DisableAlign and EnableAlign. And halve the count of calls to SetBounds by called it directly:
procedure TForm1.FormCreate(Sender: TObject);
var
I: Integer;
Control: TControl;
begin
for I := 0 to 499 do
begin
Control := TButton.Create(Self);
Control.SetBounds((I mod 10) * 40, (I div 10) * 20, 40, 20);
Control.Parent := Panel1;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
I: Integer;
C: TControl;
begin
// Disable Panel1 paint
SendMessage(Panel1.Handle, WM_SETREDRAW, Integer(False), 0);
Panel1.DisableAlign;
try
for I := 0 to Panel1.ControlCount - 1 do
begin
C := Panel1.Controls[I];
C.SetBounds(C.Left + 10, C.Top + 5, C.Width, C.Height);
end;
finally
Panel1.EnableAlign;
// Enable Panel1 paint
SendMessage(Panel1.Handle, WM_SETREDRAW, Integer(True), 0);
// Update client area
RedrawWindow(Panel1.Handle, nil, 0, RDW_INVALIDATE or RDW_UPDATENOW or RDW_ALLCHILDREN);
end;
end;
Your assumption that the slowness comes from re-painting controls is probably true, but not the whole story. The default Delphi code that handles moving controls would delay painting until the next WM_PAINT message is received, and that would happen when the message queue is pumped, after you complete moving all the controls. Unfortunately there are a lot of things involved in this, that default behavior can be altered in many places, including Delphi and Windows itself. I've used the following code to test what happens when you move a control at runtime:
var i: Integer;
begin
for i:=1 to 100 do
begin
Panel1.Left := Panel1.Left + 1;
Sleep(10); // Simulate slow code.
end;
end;
The behaviour depends on the control! A TControl (example: TLabel) is going to behave according to Delphi's rules, but a TWinControl depends on too many factors. A simple TPanel is not repainted until after the loop, in the case of TButton on my machine only the background is re-painted, while a TCheckBox is fully repainted. On David's machine the TButton is also fully repainted, proving this depends on many factors. In the case of TButton the most likely factor is the Windows version: I tested on Windows 8, David tested on Windows 7.
AlignControl Avalanche
Anyhow, there's an other really important factor to be taken into account. When you move a control at runtime, all the rules for alignment and anchoring for all the controls need to be taken into account. This likely causes an avalanche of AlignControls / AlignControl / UpdateAnchorRules calls. Since all those calls end up requiring recursive invocations of the same, the number of calls will be exponential (hence your observation that moving lots of objects on a TWinControl is slow).
The simplest solution is, as David suggests, placing everything on a Panel and moving the panel as one. If that's not possible, and all your controls are actually TWinControl (ie: they have a Window Handle), you could use:
BeginDeferWindowPos, DeferWindowPos, EndDeferWindowPos
I would put all the controls in a panel, and then move the panel rather than the controls. That way you perform the shift in a one single operation.
If you would rather move the controls within their container then you can use TWinControl.ScrollBy.
For what it is worth, it is more efficient to use SetBounds than to modify Left and Top in separate lines of code.
SetBounds(Left+DX, Top+DY, Width, Height);
To speed up you should set the Visible property of you WinControl to False during child movement to avoid repainting.
Together with SetBounds you will get the best from moving the child controls.
procedure TForm1.MoveControls( AWinControl : TWinControl; ADX, ADY : Integer );
var
LIdx : Integer;
begin
AWinControl.Visible := False;
try
for LIdx := 0 to Pred( AWinControl.ControlCount ) do
with AWinControl.Controls[LIdx] do
begin
SetBounds( Left + ADX, Top + ADY, Width, Height );
end;
finally
AWinControl.Visible := True;
end;
end;
BTW As David suggested, moving the parent is much faster than each child.
How can I make a panel appear with everything that is in it when I move my mouse over its location?
When I move it off again, it fades back out?
Doing it when it is visible is not a problem (except the fading out), I can do this with onmouseleaves.
But when it is invisible how do you make it visible?
thankssss
Put the panel on another (blank) panel. Make the "magic" panel show up when you get mouse movement over the blank panel.
Edited, because I now learned the OP has the Panel over a WebBrowser. My solution of placing an dummy / blank panel no longer works; Interfering with mouse messages going to the WebBrowser is also not a good idea, so here's a simple way to fix this. I'm using an TTimer with it's interval set to "100" and I'm pooling the mouse coordinates.
procedure TForm25.Timer1Timer(Sender: TObject);
var PR: TRect; // Panel Rect (in screen coordinates)
CP: TPoint; // Cursor Position (always in screen coordinates)
begin
// Get the panel's coordinates and convert them to Screen coordinates.
PR.TopLeft := Panel1.ClientToScreen(Panel1.ClientRect.TopLeft);
PR.BottomRight := Panel1.ClientToScreen(Panel1.ClientRect.BottomRight);
// Get the mouse cursor position
CP := Mouse.CursorPos;
// Is the cursor over the panel?
if (CP.X >= PR.Left) and (CP.X <= PR.Right) and (CP.Y >= PR.Top) and (CP.Y <= PR.Bottom) then
begin
// Panel should be made visible
Panel1.Visible := True;
end
else
begin
// Panel should be hidden
Panel1.Visible := False;
end;
end;
If you have an area that your panel will appear in, you can capture the mouse move event for the underlying form or parent panel and check it is within the bounds that your invisible panel will appear in.
eg. (pseudocode)
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if ((X > MyPanel.Left) and (Y > MyPanel.Top) and (X < mypanel.right) and
(Y < mypanel.bottom)) then
begin
mypanel.visible := true;
end;
end;