I have a descendant of TListView that offers some additional features, such as sorting and ability to load itself from a TDataset. I now wish to extend this component further so that certain aspects of the drawing can be specified at the time items are added to the list view.
I'm having trouble figuring out which procedure or procedures to override to take control of the drawing. I have overridden DrawItem to change the font style to include strikethrough and then call the inherited DrawItem. If I also specify the style LVS_OWNERDRAWFIXED (in an overriden CreateParams()) my function is called and works as I want except that only the item, and not the subitems, is drawn.
Does anyone know how I can tell the list view to draw the subitems also? I've found one example of a substantially enhanced list view, but this one isn't sufficiently well documented for me to follow exactly what's going on, and I'm hoping not to have to hook quite as many events and windows messages as this one does — it seems to me that simply setting the canvas pen, brush, and font and then having the item draw itself should not be quite so involved.
Here's what I have so far:
protected
procedure CreateParams(var Params: TCreateParams); override;
procedure DrawItem(Item: TListItem; Rect: TRect; State: TOwnerDrawState); override;
procedure TLookupListView.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
Params.Style := Params.Style or lvs_OwnerDrawFixed;
end;
procedure TLookupListView.DrawItem(Item: TListItem; Rect: TRect; State: TOwnerDrawState);
var I: Integer;
Left: Integer;
begin
Canvas.Font.Style := Canvas.Font.Style + [fsStrikeOut];
inherited DrawItem(Item, Rect, State);
//I know the canvas must be restored here, this is just for proof-of-concept.
end;
PLEASE NOTE: I'm not interested in doing custom drawing in a particular instance of TListView using the supplied events. I know how to do that. I'm trying to "bake in" this functionality to my custom TListview descendant component.
The component has a virtual method IsCustomDrawn() which is called to determine which code paths need to be executed. In the base class implementation it checks whether any of the event handlers to paint the subitems is assigned, but you can override the method to return True for all those paint stages you want handled, even when there is no event handler assigned.
If you want to handle everything in code you should probably override CustomDrawItem() and CustomDrawSubItem() and do everything there. To get everything working I would build the app with debug DCUs, step into from event handlers and look around what the minimum amount of code you can get away with is. The important method to check out is TCustomListView.CNNotify() - here the Windows messages for owner drawing are handled.
Edit:
I forgot to add that you should try to not owner draw the text in the control, but just to set canvas properties in the various paint stages - the reason being that otherwise you will have to make sure that text output is pixel-perfect in all Windows versions, something that the VCL doesn't achieve. You can see this by adding a few columns and rows to a list view and toggling the OwnerDraw property at design time, the text jumps around.
Which version of Delphi are you using? In Delphi 2007 TListView has support for custom-drawing by handling NM_CUSTOMDRAW messages, as described here. TListView already has events defined for custom-drawing subitems, as well as virtual methods you can override in your descendant.
Related
i have a problem with the VCL-Styles and MDI-Form. I want to use the VCL Styles, but i also want to draw the background (image) of my MainForm (MDI) by myself. This worked fine without VCL Styles, but when a Style is active the background image of the MainForm isn't shown.
I checked out the StyleElements for the MainForm, but exclude the seClient is ignoerd and the background image isn't shown.
When i exclude the seClient and seBoarder the image is shown again. Obviously the Form Boarder lost the Style, which is also not that what i want.
The image is drawn at the Canvas in the ClientWndProc by the messages WM_ERASEBKGND, WM_VSCROLL and WM_HSCROLL. With the Styles, it looks like this events didn't raise. Is there any way the get the image at the form background with VCL Styles active?
The main point to realize here is that form styled fsMDIForm is a very special TWinControl that manages two window handles instead of one - TWinControl.Handle and TForm.ClientHandle. While the first handle is the form window itself the second is MDI client window (container-like for MDI child windows inside MDI parent).
TFormStyleHook hooks both window procedures and introduces new method TFormStyleHook.MDIClientWndProc, which processes messages sent to MDI client. This method luckily virtual. It does some pre-processing of messages and then calls the original hooked procedure. The sad part is that it prevents calling the old procedure for WM_NCACTIVATE, WM_NCCALCSIZE, WM_NCPAINT and WM_ERASEBKGND. Even worse is that on WM_ERASEBKGND it paints the client area background directly using StyleServices.
Thanks to the above the subclassing of TFormStyleHook for MDI forms a PITA. I see multiple design flaws here:
Missing virtual TFormStyleHook.PaintMDIClientBackground similar to TFormStyleHook.PaintBackground.
No way to control/access over the original MDI client proc without hacking (hidden in private field FMDIPrevClientProc).
Disability to control styling of MDI client window via TForm.StyleElements (as noted by OP).
So what is the workaround? The easiest I can see is creating a custom style hook:
type
TMainFormStyleHook = class(TFormStyleHook)
public
procedure MDIClientWndProc(var Message: TMessage); override;
end;
{ TMainFormStyleHook }
procedure TMainFormStyleHook.MDIClientWndProc(var Message: TMessage);
begin
if Message.Msg = WM_ERASEBKGND then
begin
{ TODO: Paint background to TWMEraseBkgnd(Message).DC }
Message.Result := 1;
end
else
inherited;
end;
and applying it to your MDI parent:
type
TMainForm = class(TForm)
private
class constructor Create;
class destructor Destroy;
{ ... }
end;
{ TMainForm }
class constructor TMainForm.Create;
begin
TCustomStyleEngine.RegisterStyleHook(TMainForm, TMainFormStyleHook);
end;
class destructor TMainForm.Destroy;
begin
TCustomStyleEngine.UnRegisterStyleHook(TMainForm, TMainFormStyleHook);
end;
Note that you still need to keep painting background in MDI parent form in case the VCL styles are disabled, so it's worth creating method TMainForm.PaintMDICLientBackground(DC: HDC) and call it from both places.
I would argue that this is a bug in VCL. How about you guys?
The TDBLookupListBox (I am using Delphi Xe5) does not have an onDraw event. I need to change text colour (or text's background colour) of items displayed in the list based on certain field's values. For example, if displaying a list of employees to pick from, show employees meeting a certain condition in grey or red color, etc.
Any ideas on how to do that?
This is an ideal use case for interposing the control.
See: Delphi - Changing TComboBox's OnChange
Something like this should do the trick (pseudo code, will refine later).
type
TDBLookupListbox = class(DBcntls.TDBLookupListbox)
private
FOnDraw: TDrawEvent;
protected
procedure Paint; override;
public
property OnDraw: TDrawEvent read FOnDraw write FOnDraw;
end;
procedure TDbLookupListbox.Paint;
begin
inherited;
if Assigned(OnDraw) then FOnDraw(Self, Canvas);
end;
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;
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:
I don't know whether this question can be answered here, but I hope it will.
I wrote a simple text editor in Delphi 7 that serves as my primary IDE for writing C code under Windows. I run Windows in a VM and I needed something light.
In any case, it uses a TpageControl that gets a new tab whenever you open or create a new file. Pretty standard.
Now, the TPageControl under Delphi has no flat property.
NO I don't mean setting the tab style to tsButtons or tsFlatButtons
the borders cannot be set to "none" and it looks pretty bad when you add a text editor into the tab control.
Is there any way to make a TpageControl flat?
EDIT:
On an open source PageControl that supports flat here's what I found:
procedure TCustomTabExtControl.WndProc(var Message: TMessage);
begin
if(Message.Msg=TCM_ADJUSTRECT) and (FFlat) then
begin
Inherited WndProc(Message);
Case TAbPosition of
tpTop : begin
PRect(Message.LParam)^.Left:=0;
PRect(Message.LParam)^.Right:=ClientWidth;
PRect(Message.LParam)^.Top:=PRect(Message.LParam)^.Top-4;
PRect(Message.LParam)^.Bottom:=ClientHeight;
end;
tpLeft : begin
PRect(Message.LParam)^.Top:=0;
PRect(Message.LParam)^.Right:=ClientWidth;
PRect(Message.LParam)^.Left:=PRect(Message.LParam)^.Left-4;
PRect(Message.LParam)^.Bottom:=ClientHeight;
end;
tpBottom : begin
PRect(Message.LParam)^.Left:=0;
PRect(Message.LParam)^.Right:=ClientWidth;
PRect(Message.LParam)^.Bottom:=PRect(Message.LParam)^.Bottom-4;
PRect(Message.LParam)^.Top:=0;
end;
tpRight : begin
PRect(Message.LParam)^.Top:=0;
PRect(Message.LParam)^.Left:=0;
PRect(Message.LParam)^.Right:=PRect(Message.LParam)^.Right-4;
PRect(Message.LParam)^.Bottom:=ClientHeight;
end;
end;
end else Inherited WndProc(Message);
end;
The thing is when I tried something similar on the main application it won't work. It won't even compile.
When the tabs are drawn as buttons, no border is drawn around the display area, so set the Style property to tsButtons or tsFlatButtons. (For non-VCL programmers, this is equivalent to including the tcs_Buttons window style on the tab control.)
An alternative is to use a TNotebook. It holds pages, but it doesn't do any painting at all. You'd have to provide the tabs yourself, such as by setting the tab control's height equal to the height of the tabs, or by using a TTabSet. (TTabSet is available in Delphi 2005; I'm not sure about Delphi 7.)
Regarding the code you found, it would be helpful if you indicated why it doesn't compile, or if you gave a link to where you found it, since I suppose the compilation error was because it refers to fields or properties of the custom class rather than the stock one. Here's what you can try to put it in your own code, without having to write a custom control.
Make two new declarations in your form like this:
FOldTabProc: TWndMethod;
procedure TabWndProc(var Msg: TMessage);
In the form's OnCreate event handler, assign that method to the page control's WindowProc property:
FOldTabProc := PageControl1.WindowProc;
PageControl1.WindowProc := TabWndProc;
Now implement that method and handle the tcm_AdjustRect messsage:
procedure TForm1.TabWndProc(var Msg: TMessage);
begin
FOldTabProc(Msg);
if Msg.Msg = tcm_AdjustRect then begin
case PageControl1.TabPosition of
tpTop: begin
PRect(Msg.LParam)^.Left := 0;
PRect(Msg.LParam)^.Right := PageControl1.ClientWidth;
Dec(PRect(Msg.LParam)^.Top, 4);
PRect(Msg.LParam)^.Bottom := PageControl1.ClientHeight;
end;
end;
end;
end;
You can fill in the other three cases if you need them. Tcm_AdjustRect is a message identifier declared in the CommCtrl unit. If you don't have that message in that unit, declare it yourself; its value is 4904.
I suspect this doesn't stop the control from drawing its borders. Rather, it causes the contained TTabSheet to grow a little bigger and cover up the borders.
I'm using Delphi XE8 and the following seems to do the trick:
ATabControl.Tabs.Clear;
ATabControl.Style := TTabStyle.tsFlatButtons;
ATabControl.Brush.Color := clWhite;
You could always use a commercial solution. I would strongly recommend Raize components, which support flat TPageControls with tabs. The component set is very easy to work with, and supports numerous visual enhancements which in my opinion give a better feel to any application.
(source: raize.com)
Drop two TPageControls, one with tabs as Tabs, with a global height equal to the tabs, and one with flatbuttons and Tabvisible properties set to false, which would be aligned under the first one. Then make sure the tab change on the first TPagecontrol makes the tabs also change in the second one.