I am trying to create a Previewlist where i add an image and a remove button on top of it in TFramedVertScrollbar with this code:
var
PreviewList: TFramedVertScrollBox;
i: integer;
...
procedure TDashboard.AddClick(Sender: TObject);
var
sImg: TImage;
sBtn: TButton;
sbit: TBitmap;
begin
sbit := TBitmap.Create;
try
with sbit do
begin
Width := Image1.Bitmap.Width;
Height := Image1.Bitmap.Height;
Assign(Image1.Bitmap);
end;
sImg := TImage.Create(PreviewList);
with sImg do
begin
Align := TAlignLayout.Top;
Position.X := i * Height;
Height := 60;
Margins.Bottom := 2;
Bitmap.Assign(sbit);
Parent := PreviewList;
WrapMode := TImageWrapMode.Stretch;
onClick := PreviewItemClick;
end;
sBtn := TButton.Create(sImg);
with sBtn do
begin
StyleLookup := 'listboxdeleteitem';
Position.X := sImg.Width - 25;
Position.Y := 5;
Width := 15;
Height := 15;
Text := 'X';
Parent := sImg;
onClick := PreviewItemClick;
end;
i := i + 1;
finally
sbit.Free;
Image1.Bitmap.Assign(nil);
end;
end;
The Creation of PreviewItem works but not removal as on removing the PreviewItem the SystemBar does not responds(ex can't move or close or click) or don't takes mouse events and i have to click on other components in the form to make it responsive again.
I tried to two version of PreviewListClick first is below:
begin
PreviewList.BeginUpdate;
Obj := TButton(Sender).Parent;
FreeAndNil(Obj);
PreviewList.EndUpdate;
end;
The Above Makes the SystemBar Not Responding so i did like this :
begin
PreviewList.BeginUpdate;
PreviewList.RemoveObject(TButton(Sender).Parent);
PreviewList.EndUpdate;
end;
SystemBar is responding in this case and item is removed but there is one problem, after clicking on the Remove button of PreviewItem the PreviewList items are not updated.
For Ex. if there are four item in list and if i remove second one then item is removed but the list is not updated as the position of second item is still kept. now the PreviewList Looks like this:
Item1->BlankSPace->Item2->Item3
how to correctly add and remove items ?
Removing Object from content worked fine
PreviewList.Content.RemoveObject(TButton(Sender).Parent);
I am working on one project where I need the pixel of Last visible item in the TRichview.
By using 'LastVisibleItem' Property of TRichView I am able to find the Item Start Cordinate.
but the Problem is I need a pixel value of very last visible word.
Can any one tell me how I can get that?
Thanks in advance.
I'm a bit unsure how your LastVisibleItem property works. Below is a suggested solution to get the top-right coordinate of the last visible character. Hope it works for you.
//Function GetCharPos source: http://www.delphipages.com/forum/showthread.php?t=33707
function GetCharPos(AOwner : TControl; Index : LongInt) : TPoint;
var
p : TPoint;
begin
AOwner.Perform(EM_POSFROMCHAR,WPARAM(#p),Index);
Result := p;
end;
//Inspired by: http://www.swissdelphicenter.ch/en/showcode.php?id=1213
function GetLastVisibleCharIndex(AOwner : TControl):integer;
var
r: TRect;
begin
//The EM_GETRECT message retrieves the formatting rectangle of an edit control.
AOwner.Perform(EM_GETRECT, 0, Longint(#r));
r.Right := r.Right - 1;
r.Bottom := r.Bottom - 2;
//The EM_CHARFROMPOS message retrieves information about the character closest to a specified point in the client area of an edit control
result := AOwner.Perform(EM_CHARFROMPOS, 0, Integer(#r.BottomRight));
end;
//Get the Top-Right coordinate of the last visible character
function GetLastVisibleCharPos(AOwner : TControl):TPoint;
var Index : integer;
begin
index := GetLastVisibleCharIndex(AOwner);
result := GetCharPos(AOwner, index);
end;
Example usage:
procedure TForm2.Button3Click(Sender: TObject);
var
p : TPoint;
begin
p := GetLastVisibleCharPos(RichEdit1);
DrawCrossHair(p); //Help visualize the point
end;
//Helper proc to draw a cross-hair
procedure TForm2.DrawCrossHair(p : TPoint);
var
aCanvas: Tcanvas;
X, Y: Integer;
begin
aCanvas := TCanvas.Create;
Y := RichEdit1.Height;
X := RichEdit1.Width;
try
aCanvas.Handle := GetDC(RichEdit1.Handle);
aCanvas.Font := RichEdit1.Font;
aCanvas.Pen.color := clGreen; // Color of line
//Draw vertical line
aCanvas.MoveTo(p.x, 0);
aCanvas.LineTo(p.x, Y);
//Draw horizontal line
aCanvas.MoveTo(0, p.Y);
aCanvas.LineTo(x, p.y);
finally
ReleaseDC(RichEdit1.Handle, aCanvas.Handle);
aCanvas.Free;
end;
end;
There's a problem with the TScrollBox in Delphi 5 when using Cirtix, on some systems, when a user scrolls by clicking the button at the top or bottom of the end of scrollbar the whole application freezes. We had the issue in QucikReports previews initially and got round it by implementing our own scrollbars in the TScrollBox.
We now have a piece of bespoke work that uses a TScrollBox and the client is reporting a similar problem so I'm working round it in the same way. I hide the TScrollBox scrollbars and add in my own. When those are clicked I call the following.
Note, this test code is not currently running in Citrix, I've tested on XP and Window 7.
I am turning off redrawing of the control, moving all the child controls, then turning drawing back on and calling Invalidate. I would expect invalidate to fully redraw the control but that's not happening.
procedure TScrollBoxScrollReplacement.ScrollControls(x: Integer; y: Integer);
var
I: Integer;
begin
if (x = 0) and (y = 0) then
Exit;
// Stop the control from repaining while we're updating it
try
SendMessage(FScrollBox.Handle, WM_SETREDRAW, 0, 0);
for I := 0 to FScrollBox.ControlCount - 1 do
begin
if (FScrollBox.Controls[I] = FVScrollBar) or (FScrollBox.Controls[I] = FHScrollBar) then
Continue;
FScrollBox.Controls[I].Left := FScrollBox.Controls[I].Left + x;
FScrollBox.Controls[I].Top := FScrollBox.Controls[I].Top + y;
end;
finally
// Turn on painting again
SendMessage(FScrollBox.Handle, WM_SETREDRAW, 1, 0);
end;
// Redraw everything
InvalidateEverything(FScrollBox);
end;
Code to redraw controls
procedure TScrollBoxScrollReplacement.InvalidateEverything(AControl: TControl);
var
I: Integer;
begin
AControl.Invalidate();
if (AControl is TWinControl) then
for I := 0 to TWinControl(AControl).ControlCount - 1 do
InvalidateEverything(TWinControl(AControl).Controls[I]);
end;
I added in the Invalidate, Refresh and Reapint and loop through all child controls in an effort to get it working, but still no luck. The edit boxes look as follows:
If I set Visible to false and back to true then they'll redraw correctly, but there is obviously a horrible flicker. They also redraw correctly if I minimise the maximise the window, or drag it off and on the screen.
Any help would be much appreciated.
edit : Some info about the answers.
Users looking for a solution, I'd recommend you try both. David's and Sertac's. David's looks like it is the correct solution according to Microsoft's documentation. However, with the Delphi scrollbox, labels placed directly in the scrollbox flicker, where are labels placed in groupboxes in the scrollbox are perfectly smooth. I think this might be an issue with all components that don't descend from TWinControl. Scrolling itself is smoother with David's solution, but there's less flicking using WM_SETREDRAW and RedrawWindow. I would have liked to accept both as answers as both have their advantages and disadvantages.
edit : Code for the whole class below
To test just add a scrollbox with some controls to your form and call
TScrollBoxScrollReplacement.Create(ScrollBox1);
.
unit ScrollBoxScrollReplacement;
interface
uses extctrls, stdctrls, SpScrollBox, forms, Controls, classes, Messages, Windows, Sysutils, Math;
type
TScrollBoxScrollReplacement = class(TComponent)
private
FLastVScrollPos: Integer;
FLastHScrollPos: Integer;
FScrollBox: TScrollBox;
FVScrollBar: TScrollBar;
FHScrollBar: TScrollBar;
FVScrollBarVisible: Boolean;
FHScrollBarVisible: Boolean;
FCornerPanel: TPanel;
FMaxRight: Integer;
FMaxBottom: Integer;
FOriginalResizeEvent: TNotifyEvent;
FOriginalCanResizeEvent: TCanResizeEvent;
FInScroll: Boolean;
function GetHScrollHeight: Integer;
function GetVScrollWidth: Integer;
procedure ReplaceScrollBars;
function SetUpScrollBar(AControlScrollBar: TControlScrollBar; AKind: TScrollBarKind): TScrollBar;
procedure ScrollBoxResize(Sender: TObject);
procedure ScrollBarEnter(Sender: TObject);
procedure PositionScrollBars;
procedure Scroll(Sender: TObject; ScrollCode: TScrollCode; var ScrollPos: Integer);
procedure ScrollControls(x, y: Integer);
procedure CalculateControlExtremes();
procedure ResetVScrollBarRange;
procedure ResetHScrollBarRange;
function IsReplacementControl(AControl: TControl): Boolean;
property HScrollHeight: Integer read GetHScrollHeight;
property VScrollWidth: Integer read GetVScrollWidth;
procedure ScrollBoxCanResize(Sender: TObject; var NewWidth,
NewHeight: Integer; var Resize: Boolean);
public
constructor Create(AScrollBox: TScrollBox); reintroduce; overload;
destructor Destroy(); override;
procedure ResetScrollBarRange();
procedure BringReplacementControlsToFront();
end;
implementation
{ TScrollBoxScrollReplacement }
constructor TScrollBoxScrollReplacement.Create(AScrollBox: TScrollBox);
begin
// Set up the scrollbox as our owner so we're destroyed when the scrollbox is
inherited Create(AScrollBox);
FScrollBox := AScrollBox;
ReplaceScrollBars();
// We make a note of any existing resize and can resize events so we can call them to make sure we don't break anything
FOriginalResizeEvent := FScrollBox.OnResize;
FScrollBox.OnResize := ScrollBoxResize;
FOriginalCanResizeEvent := FScrollBox.OnCanResize;
FScrollBox.OnCanResize := ScrollBoxCanResize;
end;
// This is called (unintuitively) when controls are moved within the scrollbox. We can use this to reset our scrollbar ranges
procedure TScrollBoxScrollReplacement.ScrollBoxCanResize(Sender: TObject; var NewWidth,
NewHeight: Integer; var Resize: Boolean);
begin
if (not FInScroll) then
begin
ResetScrollBarRange();
BringReplacementControlsToFront();
end;
if (Assigned(FOriginalCanResizeEvent)) then
FOriginalCanResizeEvent(Sender, NewWidth, NewHeight, Resize);
end;
procedure TScrollBoxScrollReplacement.ScrollBoxResize(Sender: TObject);
begin
if (Assigned(FOriginalResizeEvent)) then
FOriginalResizeEvent(Sender);
ResetScrollBarRange();
end;
// Hides the original scrollbars and adds in ours
procedure TScrollBoxScrollReplacement.ReplaceScrollBars();
begin
FVScrollBar := SetUpScrollBar(FScrollBox.VertScrollBar, sbVertical);
FVScrollBarVisible := FVScrollBar.Visible;
FHScrollBar := SetUpScrollBar(FScrollBox.HorzScrollBar, sbHorizontal);
FHScrollBarVisible := FHScrollBar.Visible;
FCornerPanel := TPanel.Create(FScrollBox);
FCornerPanel.Parent := FScrollBox;
ResetScrollBarRange();
end;
procedure TScrollBoxScrollReplacement.PositionScrollBars();
begin
// Align our scrollbars correctly
FVScrollBar.Top := 0;
FVScrollBar.Left := FScrollBox.ClientWidth - FVScrollBar.Width;
FVScrollBar.Height := FScrollBox.ClientHeight - HScrollHeight;
// FVScrollBar.BringToFront();
FHScrollBar.Left := 0;
FHScrollBar.Top := FScrollBox.ClientHeight - FHScrollBar.Height;
FHScrollBar.Width := FScrollBox.ClientWidth - VScrollWidth;
// FHScrollBar.BringToFront();
// If both scrollbars are visible we'll put a panel in the corner so we can't see components through it
if (FVScrollBar.Visible) and (FHScrollBar.Visible) then
begin
FCornerPanel.Left := FHScrollBar.Width;
FCornerPanel.Top := FVScrollBar.Height;
FCornerPanel.Width := FVScrollBar.Width;
FCornerPanel.Height := FHScrollBar.Height;
FCornerPanel.Visible := True;
// FCornerPanel.BringToFront();
end
else
FCornerPanel.Visible := False;
end;
procedure TScrollBoxScrollReplacement.ResetScrollBarRange();
begin
CalculateControlExtremes();
ResetVScrollBarRange();
ResetHScrollBarRange();
PositionScrollBars();
end;
procedure TScrollBoxScrollReplacement.ResetVScrollBarRange();
var
ScrollMax: Integer;
ScrollAmount: Integer;
begin
// If all the controls fit to the right of the screen, but there are controls off the left then we'll scroll right.
ScrollMax := FMaxBottom - FScrollBox.ClientHeight + FHScrollBar.Height;
if (ScrollMax < 0) and (FLastVScrollPos > 0) then
begin
ScrollAmount := Min(Abs(ScrollMax), FLastVScrollPos);
ScrollControls(0, ScrollAmount);
FLastVScrollPos := FLastVScrollPos - ScrollAmount;
CalculateControlExtremes();
end;
FVScrollBar.Max := Max(FMaxBottom - FScrollBox.ClientHeight + FHScrollBar.Height + FLastVScrollPos, 0);
FVScrollBar.Visible := (FVScrollBar.Max > 0) and FVScrollBarVisible;
end;
procedure TScrollBoxScrollReplacement.ResetHScrollBarRange();
var
ScrollMax: Integer;
ScrollAmount: Integer;
begin
// If all the controls fit to the bottom of the screen, but there are controls off the top then we'll scroll up.
ScrollMax := FMaxRight - FScrollBox.ClientWidth + FVScrollBar.Width;
if (ScrollMax < 0) and (FLastHScrollPos > 0) then
begin
ScrollAmount := Min(Abs(ScrollMax), FLastHScrollPos);
ScrollControls(ScrollAmount, 0);
FLastHScrollPos := FLastHScrollPos - ScrollAmount;
CalculateControlExtremes();
end;
FHScrollBar.Max := Max(FMaxRight - FScrollBox.ClientWidth + FVScrollBar.Width + FLastHScrollPos, 0);
FHScrollBar.Visible := (FHScrollBar.Max > 0) and FHScrollBarVisible;
end;
function TScrollBoxScrollReplacement.SetUpScrollBar(AControlScrollBar: TControlScrollBar; AKind: TScrollBarKind): TScrollBar;
begin
Result := TScrollBar.Create(FScrollBox);
Result.Visible := AControlScrollBar.Visible;
Result.Parent := FScrollBox;
Result.Kind := AKind;
Result.Ctl3D := False;
Result.Max := AControlScrollBar.Range;
Result.OnEnter := ScrollBarEnter;
Result.OnScroll := Scroll;
Result.SmallChange := 5;
Result.LargeChange := 20;
AControlScrollBar.Visible := False;
end;
destructor TScrollBoxScrollReplacement.Destroy;
begin
inherited;
end;
procedure TScrollBoxScrollReplacement.ScrollBarEnter(Sender: TObject);
begin
// We just call this here to make sure our ranges are set correctly - a backup in case things go wrong
ResetScrollBarRange();
end;
procedure TScrollBoxScrollReplacement.Scroll(Sender: TObject;
ScrollCode: TScrollCode; var ScrollPos: Integer);
var
Change: Integer;
begin
ResetScrollBarRange();
if (Sender = FVScrollBar) then
begin
Change := FLastVScrollPos - ScrollPos;
ScrollControls(0, Change);
FLastVScrollPos := ScrollPos;
end
else if (Sender = FHScrollBar) then
begin
Change := FLastHScrollPos - ScrollPos;
ScrollControls(Change, 0);
FLastHScrollPos := ScrollPos;
end;
end;
// Moves all the controls in the scrollbox except for the scrollbars we've added
{procedure TScrollBoxScrollReplacement.ScrollControls(x: Integer; y: Integer);
var
I: Integer;
begin
if (x = 0) and (y = 0) then
Exit;
// Stop the control from repaining while we're updating it
SendMessage(FScrollBox.Handle, WM_SETREDRAW, 0, 0);
FInScroll := True;
try
for I := 0 to FScrollBox.ControlCount - 1 do
begin
if IsReplacementControl(FScrollBox.Controls[I]) then
Continue;
FScrollBox.Controls[I].Left := FScrollBox.Controls[I].Left + x;
FScrollBox.Controls[I].Top := FScrollBox.Controls[I].Top + y;
end;
finally
// Turn on painting again
FInScroll := False;
SendMessage(FScrollBox.Handle, WM_SETREDRAW, 1, 0);
end;
// Redraw everything
RedrawWindow(FSCrollBox.Handle, nil, 0, RDW_ERASE or RDW_INVALIDATE or RDW_ALLCHILDREN);
end; }
procedure TScrollBoxScrollReplacement.ScrollControls(x: Integer; y: Integer);
var
I: Integer;
Control: TControl;
WinControl: TWinControl;
hWinPosInfo: HDWP;
begin
if (x = 0) and (y = 0) then
Exit;
hWinPosInfo := BeginDeferWindowPos(0);
Win32Check(hWinPosInfo<>0);
try
for I := 0 to FScrollBox.ControlCount - 1 do
begin
Control := FScrollBox.Controls[I];
if (Control = FVScrollBar) or (Control = FHScrollBar) then
Continue;
if Control is TWinControl then
begin
WinControl := FScrollBox.Controls[I] as TWinControl;
hWinPosInfo := DeferWindowPos(
hWinPosInfo,
WinControl.Handle,
0,
WinControl.Left + x,
WinControl.Top + y,
WinControl.Width,
WinControl.Height,
SWP_NOZORDER or SWP_NOOWNERZORDER or SWP_NOACTIVATE
);
Win32Check(hWinPosInfo<>0);
end
else
Control.SetBounds(Control.Left + x, Control.Top + y, Control.Width, Control.Height);
end;
finally
EndDeferWindowPos(hWinPosInfo);
end;
end;
// works out where our right most and bottom most controls are so we can set the scrollbars correctly
procedure TScrollBoxScrollReplacement.CalculateControlExtremes();
var
I: Integer;
Right: Integer;
Bottom: Integer;
begin
FMaxRight := 0;
FMaxBottom := 0;
for I := 0 to FScrollBox.ControlCount - 1 do
begin
if IsReplacementControl(FScrollBox.Controls[I]) then
Continue;
Right := FScrollBox.Controls[I].Left + FScrollBox.Controls[I].Width;
Bottom := FScrollBox.Controls[I].Top + FScrollBox.Controls[I].Height;
FMaxRight := Max(FMaxRight, Right);
FMaxBottom := Max(FMaxBottom, Bottom);
end;
end;
function TScrollBoxScrollReplacement.GetHScrollHeight: Integer;
begin
if (FHScrollBar.Visible) then
Result := FHScrollBar.Height
else
Result := 0;
end;
function TScrollBoxScrollReplacement.GetVScrollWidth: Integer;
begin
if (FVScrollBar.Visible) then
Result := FVScrollBar.Width
else
Result := 0;
end;
// Returns true if the passed control is one of the controls we've added
function TScrollBoxScrollReplacement.IsReplacementControl(
AControl: TControl): Boolean;
begin
Result := (AControl = FVScrollBar) or (AControl = FHScrollBar) or (AControl = FCornerPanel);
end;
procedure TScrollBoxScrollReplacement.BringReplacementControlsToFront;
begin
FVScrollBar.BringToFront();
FHScrollBar.BringToFront();
FCornerPanel.BringToFront();
end;
end.
I found that your code started working once I remove the two WM_SETREDRAW messages. That's your fundamental problem. You will need to remove the WM_SETREDRAW messages.
That will no doubt mean you still need to solve your problem with flickering, but that's a different problem. My quick experiments suggest that DeferWindowPos could solve that problem. For example:
procedure TScrollBoxScrollReplacement.ScrollControls(x: Integer; y: Integer);
var
I: Integer;
Control: TControl;
WinControl: TWinControl;
hWinPosInfo: HDWP;
begin
if (x = 0) and (y = 0) then
Exit;
hWinPosInfo := BeginDeferWindowPos(0);
Win32Check(hWinPosInfo<>0);
try
for I := 0 to FScrollBox.ControlCount - 1 do
begin
Control := FScrollBox.Controls[I];
if (Control = FVScrollBar) or (Control = FHScrollBar) then
Continue;
if Control is TWinControl then
begin
WinControl := FScrollBox.Controls[I] as TWinControl;
hWinPosInfo := DeferWindowPos(
hWinPosInfo,
WinControl.Handle,
0,
WinControl.Left + x,
WinControl.Top + y,
WinControl.Width,
WinControl.Height,
SWP_NOZORDER or SWP_NOOWNERZORDER or SWP_NOACTIVATE
);
Win32Check(hWinPosInfo<>0);
end
else
Control.SetBounds(Control.Left + x, Control.Top + y, Control.Width, Control.Height);
end;
finally
EndDeferWindowPos(hWinPosInfo);
end;
end;
Your non-windowed controls will still flicker, but you can make them windowed, or indeed put the whole content of the scroll box inside a windowed control. Heck, if you just did that, it would be enough to solve the problem!
For what it is worth, my trials indicate that DeferWindowPos gives smoother scrolling than WM_SETREDRAW and RedrawWindow. But these tests were hardly exhaustive and you might find different outcomes in your app.
Some asides regarding your code:
Your use of try/finally is incorrect. The pattern must be:
BeginSomething;
try
Foo;
finally
EndSomething;
end;
You get that wrong with your calls to SendMessage.
And you use an incorrect cast in InvalidateEverything. You cannot blindly cast a TControl to TWinControl. That said, that function does no good. You can remove it altogether. What it is attempting to do can be performed with a single call to Invalidate of the parent control.
You can replace your
FScrollBox.Invalidate();
with
RedrawWindow(FSCrollBox.Handle, nil, 0,
RDW_ERASE or RDW_INVALIDATE or RDW_ALLCHILDREN);
to have all controls invalidated and updated properly. RDW_ERASE is for erasing the previous positions of controls and RDW_ALLCHILDREN is for taking care of windowed controls inside. Non-win controls like labels should already be repainted because of RDW_INVALIDATE.
Although this approach may help avoiding the flicker that you observe, it may also cause some loss of smoothness of scrolling while thumb tracking. That's because the scroll position might need to be updated more often than a paint cycle is processed. To circumvent this, instead of invalidating you can update the control positions immediately:
RedrawWindow(FSCrollBox.Handle, nil, 0,
RDW_ERASE or RDW_INVALIDATE or RDW_UPDATENOW or RDW_ALLCHILDREN);
The only dock style in JVCL that I know that has the auto hide function (to pin the dock clients) is JvDockVSNetStyle. I'm using it but I can't set the size of the inactive pinned panes' tabs. When hidden, the tabs don't show the title of the pane, only the name of the active pane is shown. Sorry, I can't post an example image because that's my first question.
In the object inpector there is an option called ChannelOption with the ActivePaneSize property. Is there a way to set the inactive pane size so it can show its name? Or maybe there is another dock style that I'm missing that has the same functions?
I'm using C++Builder and JVCL 3.45.
i did it by commenting out these code parts:
procedure TJvDockVSChannel.GetBlockRect(Block: TJvDockVSBlock; Index: Integer;
var ARect: TRect);
var
BlockWidth: Integer;
begin
// HERE
// if Block.VSPane[Index] <> Block.ActivePane then
// BlockWidth := Block.InactiveBlockWidth
// else
BlockWidth := Block.ActiveBlockWidth;
<snip>
procedure TJvDockVSChannel.Paint;
var
I: Integer;
<snip>
begin
VisiblePaneCount := 0;
for I := 0 to Block.VSPaneCount - 1 do
begin
if not Block.VSPane[I].FVisible then
Continue;
GetBlockRect(Block, I, DrawRect);
Canvas.Brush.Color := TabColor;
Canvas.FillRect(DrawRect);
Canvas.Brush.Color := clGray;
Canvas.FrameRect(DrawRect);
AdjustImagePos;
Block.FImageList.Draw(Canvas, DrawRect.Left, DrawRect.Top, I, dsTransparent, itImage);
// HERE
// if Block.ActivePane = Block.VSPane[I] then
begin
if Align in [alTop, alBottom] then
Inc(DrawRect.Left, Block.InactiveBlockWidth)
else
if Align in [alLeft, alRight] then
begin
Inc(DrawRect.Top, Block.InactiveBlockWidth);
if Align = alLeft then
DrawRect.Left := 15
else
DrawRect.Left := 20;
DrawRect.Right := DrawRect.Left + (DrawRect.Bottom - DrawRect.Top);
end;
Canvas.Brush.Color := TabColor;
Canvas.Pen.Color := clBlack;
Dec(DrawRect.Right, 3);
OldGraphicsMode := SetGraphicsMode(Canvas.Handle, GM_ADVANCED);
Canvas.Brush.Style := bsClear;
// HERE (changed options)
DrawText(Canvas.Handle, PChar(Block.VSPane[I].FDockForm.Caption), -1, DrawRect, {DT_END_ELLIPSIS or} DT_NOCLIP);
There is an event in TJvDockServer called DoFinishSetDockPanelSize.
Within the function you create for that event you can access the size of a form using Dockpanel. There may be a way from here to set the size of the tabs.
What would be the most simple and clean way to show a focused/selected listbox item with a Office XP style?
See this sample image to show the idea more clearer:
I think I need to set the Listbox Style to either lbOwnerDrawFixed or lbOwnerDrawVariable and then modify the OnDrawItem event?
This is where I am stuck, I am not really sure what code to write in there, so far I tried:
procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
begin
with (Control as TListBox).Canvas do
begin
if odSelected in State then
begin
Brush.Color := $00FCDDC0;
Pen.Color := $00FF9933;
FillRect(Rect);
end;
TextOut(Rect.Left, Rect.Top, TListBox(Control).Items[Index]);
end;
end;
I should of known that would not work, I get all kind of funky things going on:
What am I doing wrong, more importantly what do I need to change to make it work?
Thanks.
You forgot to paint the items for different states. You need to determine in what state the item currently is and according on that draw it.
What you have on your picture you can get this way. However this doesn't looks well if you have enabled multiselect and select more than one item:
procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
var
Offset: Integer;
begin
with (Control as TListBox) do
begin
Canvas.Font.Color := Font.Color;
if (odSelected in State) then
begin
Canvas.Pen.Color := $00FF9932;
Canvas.Brush.Color := $00FDDDC0;
end
else
begin
Canvas.Pen.Color := Color;
Canvas.Brush.Color := Color;
end;
Canvas.Rectangle(Rect);
Canvas.Brush.Style := bsClear;
Offset := (Rect.Bottom - Rect.Top - Canvas.TextHeight(Items[Index])) div 2;
Canvas.TextOut(Rect.Left + Offset + 2, Rect.Top + Offset, Items[Index]);
end;
end;
And the result with ItemHeight set to 16:
Bonus - continuous selection:
Here is a tricky solution implementing a continuous selection. The principle is to draw the item like before but then overdraw the item's border top and bottom lines with the lines of a color depending on selection state of the previous and next item. Except that, must be rendered also outside of the current item, since the item selection doesn't naturally invoke neighbour items to be repainted. Thus the horizontal lines are painted one pixel above and one pixel below the current item bounds (colors of these lines depends also on the relative selection states).
Quite strange here is the use of item objects to store the selected state of each item. I did that, because when using a drag & drop item selection, the Selected property doesn't return the real state until you release the mouse button. Fortunately, the OnDrawItem event of course fires with the real state, so as a workaround I've used storing of these states from the OnDrawItem event.
Important:
Notice, that I'm using the item objects to store the actual selection state, so be careful, and when you're using item objects for something else, store this actual states e.g. into an array of Boolean.
procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
const
SelBackColor = $00FDDDC0;
SelBorderColor = $00FF9932;
var
Offset: Integer;
ItemSelected: Boolean;
begin
with (Control as TListBox) do
begin
Items.Objects[Index] := TObject((odSelected in State));
if (odSelected in State) then
begin
Canvas.Pen.Color := SelBorderColor;
Canvas.Brush.Color := SelBackColor;
Canvas.Rectangle(Rect);
end
else
begin
Canvas.Pen.Color := Color;
Canvas.Brush.Color := Color;
Canvas.Rectangle(Rect);
end;
if MultiSelect then
begin
if (Index > 0) then
begin
ItemSelected := Boolean(ListBox1.Items.Objects[Index - 1]);
if ItemSelected then
begin
if (odSelected in State) then
begin
Canvas.Pen.Color := SelBackColor;
Canvas.MoveTo(Rect.Left + 1, Rect.Top);
Canvas.LineTo(Rect.Right - 1, Rect.Top);
end
else
Canvas.Pen.Color := SelBorderColor;
end
else
Canvas.Pen.Color := Color;
Canvas.MoveTo(Rect.Left + 1, Rect.Top - 1);
Canvas.LineTo(Rect.Right - 1, Rect.Top - 1);
end;
if (Index < Items.Count - 1) then
begin
ItemSelected := Boolean(ListBox1.Items.Objects[Index + 1]);
if ItemSelected then
begin
if (odSelected in State) then
begin
Canvas.Pen.Color := SelBackColor;
Canvas.MoveTo(Rect.Left + 1, Rect.Bottom - 1);
Canvas.LineTo(Rect.Right - 1, Rect.Bottom - 1);
end
else
Canvas.Pen.Color := SelBorderColor;
end
else
Canvas.Pen.Color := Color;
Canvas.MoveTo(Rect.Left + 1, Rect.Bottom);
Canvas.LineTo(Rect.Right - 1, Rect.Bottom);
end;
end;
Offset := (Rect.Bottom - Rect.Top - Canvas.TextHeight(Items[Index])) div 2;
Canvas.Brush.Style := bsClear;
Canvas.Font.Color := Font.Color;
Canvas.TextOut(Rect.Left + Offset + 2, Rect.Top + Offset, Items[Index]);
end;
end;
And the result:
You need to look at the value of the State variable that is passed into the function. This tells you if the item is selected or not and you can then set the brush and pen appropriately.