How to change the ListView OnDrag image? - delphi

I'm using a ListView with the ViewStyle := vsReport. When I drag a row from one point to another point it takes the value of column one of the row being dragged (in the case it's 1) and displays it inside a dark grey rectangle as shown below.
I've tried looking around in the XE4 source code but can't find where this background color is set. I'd like to change this background color to clSkyBlue (or something similar) but don't know how it's done.
How do you go about changing the default dark grey background image of the drag operation?

VCL's drag operations does not have drag images out of the box, but it does provide a mechanism for providing a drag image to be used. This is normally done by constructing your own "drag image list", either by overriding the GetDragImages method of the control itself (when an internal drag object is used), or by constructing your own "drag object" when the drag is started, and assemble an image list in its GetDragImages method to be called by the VCL when the drag is initiated.
This mechanism is a bit different though for TListView and TTreeView controls because the underlying api controls themselves natively support providing a drag image for the item that's being dragged. Hence, unlike other controls, these controls override their GetDragImages methods and return the image list that's being created in overriden DoStartDrag methods where the controls ask the api to provide the image list. This is why you won't be able to find where a drag image is created in VCL code.
To override this behavior, one could possibly override these (and possibly a few other) methods in a descendant class and implement them. I don't know if this would be easy or not, I find providing an image list through constructing a drag object in the OnStartDrag event handler easier. This normally does not have any effect, since by the time GetDragImages of our drag object is called, the VCL already has settled on an image list which the api has supplied and the api has created a temporary list that's being dragged. Then, we can force the dragging of the original image list to an end and substitute our own.
Below is an oversimplified example. Apart from error handling, resource protecting, hot spot determining etc.. look to VCL code to see how it ensures there's actually an item that's being dragged.
type
TListWiewDragControlObjectEx = class(TDragControlObjectEx)
protected
function GetDragImages: TDragImageList; override;
end;
function TListWiewDragControlObjectEx.GetDragImages: TDragImageList;
var
Bmp: TBitmap;
R: TRect;
begin
Bmp := TBitmap.Create;
Bmp.Canvas.Brush.Color := clSkyBlue;
R := TListView(Control).Selected.DisplayRect(drBounds);
Bmp.SetSize(R.Right - R.Left, R.Bottom - R.Top);
Bmp.Canvas.Font := TListView(Control).Font;
Bmp.Canvas.TextOut(0, 0, TListView(Control).Selected.Caption);
Result := TDragImageList.Create(Control);
Result.Width := Bmp.Width;
Result.Height := Bmp.Height;
ImageList_EndDrag; // end the drag with the temporary list
Result.SetDragImage(Result.Add(Bmp, nil), 0, 0);
Bmp.Free;
end;
procedure TForm1.ListView1StartDrag(Sender: TObject;
var DragObject: TDragObject);
begin
DragObject := TListWiewDragControlObjectEx.Create(ListView1);
DragObject.AlwaysShowDragImages := True;
end;

Related

What causes a control to be placed more left-right-top-bottom than another which has same alignment? [duplicate]

In this particular case I'm using PowerPDF library to dynamically build a PDF document, but the same applies for the general concept of dynamically aligning controls sequentially inside of a parent control. In this library, TPRPage is the base control to contain all element controls, in this case, sequential instances of TPRLayoutPanel.
What I do when dynamically adding controls:
Create a control (TPRLayoutPanel)
Set the control's parent (TPRPage)
Align the control to top (PRLayoutPanel.Align:= alTop;)
The problem is it gets forced to the very beginning (top) instead of the very end (bottom) of the page.
I've tried setting its order PRLayoutPanel.SendToBack; or PRLayoutPanel.BringToFront but with no luck.
How can I dynamically create and align multiple controls within a parent control sequentially? My only current work-around is to add the controls in reverse order (from end to beginning) which is ridiculously unnecessary.
Here's my universal function which creates every new instance of an aligned control in this parent:
function TfrmReport.InsertPanel: TPRLayoutPanel;
begin
Result:= TPRLayoutPanel.Create(PRPage);
Result.Parent:= PRPage;
Result.Align:= alTop;
Result.Height:= 40; //Default, may change later
end;
Once again, DisableAlign and EnableAlign to the rescue:
procedure TForm1.FormCreate(Sender: TObject);
var
I: Integer;
P: TPanel;
begin
DisableAlign;
try
for I := 0 to 4 do
begin
P := TPanel.Create(Self);
P.Caption := IntToStr(I);
P.Align := alTop;
P.Parent := Self;
end;
finally
EnableAlign;
end;
end;
Explanation:
When alignment is enabled, every single addition of a control to a container (the form itself in this specific case) will re-evaluate all alignment (and anchor) settings of all other controls within that container. In case that control has no specific Top property set, then Top will be 0. When there is already another control aligned to the top, then there are two controls with Top = 0, and the one which is about to inserted wins. I (currently) have no in-depth explanation for that, but it just is, and the position order indeed gets reversed from the creation order.
Now, when alignment of the container is disabled, then consecutive added controls are simply just inserted with all their positioning properties unaltered. When alignment is enabled again, then all those controls are re-evaluated in the same manner, with the difference that this takes place in one single loop in the order of the index in the Controls array; i.e. the order in which they were created.
You need to set the Top property to be the bottom of the previous panel. For example, like this:
PanelTop := 0;
for i := 0 to 5 do
begin
Panel[i] := TPanel.Create(Self);
Panel[i].Parent := Self;
Panel[i].Height := PanelHeight;
Panel[i].Align := alTop;
Panel[i].Top := PanelTop;
inc(PanelTop, PanelHeight);
end;
To fit it into your code you'd have to keep track of the location of the most recently added panel. Perhaps you could add a var parameter to your InsertPanel function:
function TfrmReport.InsertPanel(var PanelTop: Integer): TPRLayoutPanel;
begin
Result:= TPRLayoutPanel.Create(PRPage);
Result.Parent:= PRPage;
Result.Top:= PanelTop;
Result.Height:= 40;
Result.Align:= alTop;
inc(PanelTop, Result.Height);
end;
I trust you get the idea!
You may use alCustom align type and control all of your panels positions via CustomAlignPosition method (you will need to override it in parent control). This will give you more flexibility and control.

Adding label to custom component as a child

I have a custom component TCard = class(TGraphicControl) I would like for when its created it would have a label inside it's area ex (top := 5 ) (left :=5) and it would always put a TLabel on that TCard at that spot when created.
type
TCard = class(TGraphicControl)
private
FLPower:TLabel;
procedure SetLPower(value:TLabel);
protected
procedure Paint; override;
public
property LPower: TLabel read FLpower write SetLPower;
...
constructor Tcard.Create(AOwner: Tcomponent);
begin
inherited Create(AOwner);
FLPower := TLabel.Create(self);
end
procedure TCard.SetLPower(value: TLabel);
begin
FLPower.Assign(value);
end;
procedure Tcard.Paint;
begin
FLPower.Left := 5;
FLPower.Top := 5;
end;
I know what i have is not right, but i wanted to show something. Also if it helps, i plan in future to beable to do TCard.LPower.Caption := inttostr(somenumber); So if you can work that in then bonuse .. if not i can figure that out later..but wanted to give a heads up incase something you suggest would not work due to that.
Thanks
glen
A TGraphicControl cannot be used as a parent control and so you cannot adopt this approach.
A label is essentially something very simple. It's just text. You have chosen to use TGraphicControl so that implies that you are going to implement a Paint method.
So, instead of creating a label control, add a Text property of type string to your control. Then, in the Paint method, draw the text to the paint canvas. When the Text property is modified, invalidate your control so that it can be repainted.
In any case, doing it this way is the right way to do it. Adding extra controls just to draw text is over the top. You've picked the lightest weight control which is fine. Paint your card's background, and then paint any text that is required. Job done.

Close button appears on my docked control after redocking

I have a paint box which I want the user to be able to undock and move around. So I set its DragKind to dkDock and its DragMode to dmAutomatic, and put it inside a panel with DockSite set to True. I'm experiencing a rather odd behavior when I dock the paint box after having undocked it to a floating form. The close button of the floating form appears inside the panel. I've attached two screenshots. One from the original state, and one after docking the paint box again. What am I missing?
Original State:
After docking:
UPDATE
After using TLama's solution, here's the result.
You're not missing anything. That's how the default dock manager implementation works. It just wants to have grabber with the close button available on dock site, which uses it. What you can do, is implement your own dock manager and override its AdjustDockRect method, which controls the size of docking zone and where is in default dock manager implementation made a space for grabber with close button. If you don't want that grabber, just keep the size of dock zone rectangle as it was passed to the method, in size of the whole dock site. In other words, do nothing in that method override.
That's for the functional part of the grabber, but except that you need to intercept hardcoded drawing of it. To do so, you need to override the PaintDockFrame event method and like before, do just nothing there.
Here's a code sample:
type
TNoGrabDockManager = class(TDockTree)
protected
procedure AdjustDockRect(Control: TControl; var ARect: TRect); override;
procedure PaintDockFrame(Canvas: TCanvas; Control: TControl;
const ARect: TRect); override;
end;
implementation
{ TNoGrabDockManager }
procedure TNoGrabDockManager.AdjustDockRect(Control: TControl; var ARect: TRect);
begin
// here you can make space for a grabber by shifting top or left position
// of the ARect parameter, which is by default set to the whole dock site
// bounds size, so if you do nothing here, there will be no grabber
end;
procedure TNoGrabDockManager.PaintDockFrame(Canvas: TCanvas; Control: TControl;
const ARect: TRect);
begin
// in this event method, the grabber with that close button are drawn, so
// as in case of disabling grabber functionality do precisely nothing for
// drawing it here, that will make it visually disappear
end;
Here's how to use such custom dock manager (see below for note about UseDockManager property):
procedure TForm1.FormCreate(Sender: TObject);
begin
Panel1.DockManager := TNoGrabDockManager.Create(Panel1);
Panel1.UseDockManager := True;
end;
Important
As few sources suggest, you should set the UseDockManager property of your dock panel to False at design time. I don't know why, but from quick tests I've made, some of the event methods of the custom dock manager were not fired when I didn't have set that property at design time (the AdjustDockRect event method worked properly even without doing so, but I wouldn't personally rely on it).
Rather than using a panel as the dock target, use a TPageControl and hide the tab from the generated tab sheet. Since a page control normally has visible tabs, the delete handle is not displayed. Unfortunately, when you hide a tab sheet's tab, the sheet itself is also hidden. So you must save and restore it by adding the following OnDockDrop event:
procedure TForm2.PageControl1DockDrop(Sender: TObject; Source: TDragDockObject;
X, Y: Integer);
var
ix: Integer;
begin
ix := PageControl1.ActivePageIndex;
PageControl1.ActivePage.TabVisible := false;
PageControl1.ActivePageIndex := ix;
end;

How can I remove the or change the "horizontal separator" in a Category Panel control?

I've been playing around with the Category Panel Control inside Delphi 2010. I've been able to modify the colors and get them working they way I'd like. However, there's a silver colored "horizontal separator" (I don't know what else to call it) between each panel heading.
How can I change the appearance of this "horizontal separator" or remove it all together?
A look at the source of T(Custom)CategoryPanel reveals a method DrawCollapsedPanel. It unconditionally draws the separator. DrawCollapsedPanel is called from DrawHeader and the only condition checked is whether the panel is collapsed.
More importantly though, DrawCollapsedPanel is virtual, so you can either create your own descendant or use an interceptor class:
TCategoryPanel = class(ExtCtrls.TCategoryPanel)
protected
procedure DrawCollapsedPanel(ACanvas: TCanvas); override;
function GetCollapsedHeight: Integer; override;
end;
If you put this in a separate unit, all you need to do then is include it AFTER the ExtCtrls unit wherever you want a category panel with your own behaviour.
To please David :-)
procedure TCategoryPanel.DrawCollapsedPanel(ACanvas: TCanvas);
begin
// Don't call inherited, we do not want the default separator.
// And don't draw anything you don't want.
end;
and we need to override GetCollapsedHeight as well, as that determines the room available for whatever you want to draw under the Header in a collapsed state:
function TCategoryPanel.GetCollapsedHeight: Integer;
begin
// As we don't want anything under here,
// don't call inherited and just return the HeaderHeight.
// (Instead of HeaderHeight + 6;
Result := HeaderHeight;
end;
Screenshot:

Image Preview in a Listbox

How can I display a preview (almost like a hint) of an image when I hover the mouse over an item in a listbox of filenames? I've tried showing a form and loading the image, but when the preview form shows, I lose focus for the listbox which means that when I move the mouse, the preview image does not change when I go to the next item in the list.
Thanks, Pieter.
I have, based on the answer from TOndrej, tried to implement a custom THintWindow, but the Canvas.StretchDraw does not draw the bitmap sent as a parameter. Any ideas why not? Text is displayed normally.
procedure TFormMain.DisplayPreview(HintImage: TBitmap);
var
CustomHint: THintWindow;
Rect: TRect;
MousePoint: TPoint;
begin
*{
Based on Source: http://www.chami.com/tips/delphi/112996D.html
}*
GetCursorPos(MousePoint);
with Rect do
begin
// set the position and size of the hint window
Left := MousePoint.X;
Top := MousePoint.Y;
Right := Left + 50;
Bottom := Top + 25;
end;
CustomHint := THintWindow.Create(Self);
try
with CustomHint do
begin
// set the background color
//Color := clNone;
**Canvas.StretchDraw(Rect, HintImage);**
ActivateHint(Rect, 'Hint');
Application.ProcessMessages;
//
// perform your tasks here
// before closing the hint window
//
Sleep(500);
ReleaseHandle;
end;
finally
if Assigned(CustomHint) then
CustomHint.Free;
end;
end;
To me it seems you want a custom hint window. To do this you should write a new THintWindow descendant and either set it globally to the whole application by assigning your new class to the HintWindowClass global variable in Forms unit, or write your own listbox descendant in which you will handle CM_HINTSHOW message and assign your new hint window class to HintInfo.HintWindowClass. (HintInfo points to a record passed to your control in the CM_HINTSHOW message by the VCL.)
1) Are you displaying your preview form like a dialog (Modal Window) if yes then change it to non modal window.
2) Remember to set focus back to your parent window once the preview form shows up, that way your parent form that has the listbox has the focus and it will pass the mouse move events to the listbox.
Best Regards.

Resources