How to enable onDraw (ownerDraw) for TDBLookupListBox - delphi

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;

Related

How can I get a TDBLookupComboBox to show what you are typing?

I have a TDBLookupComboBox on my form.
When I put my cursor in it and type, the selection jumps a head to what I've typed (or as close as it can).
However I don't get any indication of what I've typed in the field.
TDBComboBox performs similarly to TDBLookupComboBox however, when I type in the field, the characters I type appear in regular text, and the 'completion' of the selection appears in inverse/selected following the regular text.
Is there a way I can make TDBLookupComboBox perform like TDBComboBox in this respect?
No, you can't make TDBLookupComboBox act like a TDBComboBox (without a bit of hacking).
The problem is that TDBLookupComboBox is used to lookup an index-field (normally a number) from another table. The chosen index is set in the destination-field. When you make TDBLookupComboBox "editable" (like TDBComboBox), you could type in anything, even values not in the source-table. And that shouldn't happen (by design). What index-value would you set in that case in the destination field?
You have several options.
You could "hack" TDBLookupComboBox to override the paint procedure to overwrite the selected text with the not selected (already typed) text. It's not easy. Especially if you want to maintain the functionality correctly. But here is some code where I think I've come close to what you want. Although when typing something that's not in the lookup-dataset it doesn't go any further. (It also doesn't account for right aligned text etc.):
type
TDBLookupComboBox = class(DBCtrls.TDBLookupComboBox)
protected
procedure Paint; override;
procedure KeyPress(var Key: Char); override;
end;
type
TForm1 = class(TForm)
DBLookupComboBox1: TDBLookupComboBox;
//.....
procedure TDBLookupComboBox.Paint;
var
TextPart: String;
begin
inherited;
Canvas.Font := Font;
Canvas.Brush.Color := Color;
// keeps case like the field is drawn
TextPart := Copy(Text, 1, Length(SearchText));
Canvas.TextOut(2, 2, TextPart);
end;
procedure TDBLookupComboBox.KeyPress(var Key: Char);
begin
inherited;
// we need this because paint is already called
// we need to call it again to overwrite the text
invalidate;
end;
It overrides the DBLookupComboBox at the top of your form. You don't have to compile this into a new component. You can just paste it into your form with the DBLookupComboBox. We need to call Paint again after keypress (with invalidate) because paint is already called before coming to that routine.
Another option is to use the TDBComboBox. You can fill the pulldown-items in OnEnter.
procedure TForm1.DBComboBox1Enter(Sender: TObject);
begin
DBComboBox1.Items.Clear;
IBQuery1.First;
while not IBQuery1.EOF do
begin
DBComboBox1.Items.Add(IBQuery1.FieldByName('TESTFIELD').DisplayText);
IBQuery1.Next;
end;
end;
If that's too slow (when entering the combobox) you could also fill the items at opening of the dataset.
Another few options from Jedi-library:
JvDBLookupCombo1
Has a pulldown directly when typing. The original typed text stays in the box.
TJvDBSearchComboBox
Also does what you want but is not connected to a destination datasource. You'll need to set the desired field yourself on OnExit.

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.

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:

Custom drawing in TListview descendant

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.

TLinkLabel background on a TPageControl

I am trying to use a TLinkLabel on a TPageControl, and I can't find a way to make it use it's parent's background.
// Image removed because the website doesn't exist any more
// and I can't find it anywhere... Sorry.
As you can see, the parent tab sheet's lovely gradient is not preserved behind the link text.
I would like the functionality of having multiple links in a flowing block of text (the functionality that TLinkLabel provides) and have the background of the parent showing behind the text.
TLinkLabel does not have a ParentBackground property. I have tried creating a derived class that adds csParentBackground to the control style, to no avail:
TMyLinkLabel = class (TLinkLabel)
public
constructor Create(AOwner: TComponent); override;
end;
...
constructor TMyLinkLabel.Create(AOwner: TComponent);
begin
inherited;
ControlStyle := ControlStyle - [csOpaque] + [csParentBackground]
end;
Anyone have any ideas?
Nat, you are nearly there with your changes to the ControlStyle of the TLinkLabel. What you have to do in addition is to make sure that the parent of the standard Windows static control (that's what the TLinkLabel is) handles the WM_CTLCOLORSTATIC message correctly.
The VCL has a nice redirection mechanism to let controls handle messages that are sent as notifications to their parent windows for themselves. Making use of this a completely self-contained transparent link label can be created:
type
TTransparentLinkLabel = class(TLinkLabel)
private
procedure CNCtlColorStatic(var AMsg: TWMCtlColorStatic);
message CN_CTLCOLORSTATIC;
public
constructor Create(AOwner: TComponent); override;
end;
constructor TTransparentLinkLabel.Create(AOwner: TComponent);
begin
inherited;
ControlStyle := ControlStyle - [csOpaque] + [csParentBackground];
end;
procedure TTransparentLinkLabel.CNCtlColorStatic(var AMsg: TWMCtlColorStatic);
begin
SetBkMode(AMsg.ChildDC, TRANSPARENT);
AMsg.Result := GetStockObject(NULL_BRUSH);
end;
Normally I hate it when people offer a third-party component as an answer, but I'll mention the TMS THTMLabel as an alternative for what you want to do. It has the Transparent property of the TLabel, and allows you to use HTML as the caption, and so you can do multiple links as per your example.
The csParentBackground and csOpaque styles both require cooperation from other parts of the control's code. Merely setting them wouldn't have much effect; if it did, then the control would probably have a public Transparent property already.
You can look at TCustomLabel.Paint to see how it respects the csOpaque style. It checks for that style by reading its Transparent property before it paints its background:
if not Transparent then
begin
Canvas.Brush.Color := Self.Color;
Canvas.Brush.Style := bsSolid;
FillRect(ClientRect);
end;
The csParentBackground style has no effect on TCustomLabel because that style only affects windowed controls; TCustomLabel descends from TGraphicControl, not TWinControl.
I don't have TLinkLabel, so I can't look at its source code to find out what it would need to change. If it's a TGraphicControl descendant, then it would need to include code like I showed above from TCustomLabel. If it descends from TWinControl, then I'd adapt code from TCustomStaticText instead. That's a little more complicated; it calls DrawParentBackground in response to the cn_CtlColorStatic notification message. It also doesn't paint itself in Delphi code. The control is a wrapper for the Win32 "static" control type.
TLinkLabel evidently paints its background unconditionally. To fix this, you'll need to override the Paint method. Removing functionality (background-painting, in this case) is hard to do with the traditional way of overriding virtual methods because you won't be able to call the inherited method to get all the text painted. Instead, You'll probably have to copy and paste the base class's implementation and then add the conditional parts in the middle somewhere.
One way I can think of is to create helper class under implementation
type
TLinkLabelHelper = class helper for TLinkLabel
public
procedure Add(const aBGColor: TColor; const S: string);
end;
procedure TLinkLabelHelper.Add(const aBGColor: TColor; const S: string);
begin
Color := aBGColor;
Caption := S;
end;
Then, I create a public
procedure AfterConstruction; override;
procedure Form_A.AfterConstruction;
begin
inherited;
LinkLabel1.Add(Self.Color, 'Hello World');
end;
Hope this works.
My advice: use simple TLabel. TLabel has a property named Transparent - this is what you need. Set your TLabels cursor to crHandPoint (AFAIR this is the link cursor), set font to blue underline, and write OnClick event handler, that will open web browser to navigate to the pointed url.
You can even have one default event handler.
procedure OnClickOnMyLinkTLabels(Sender : TObject);
var
Address : string;
begin
if NOT (Sender is TLabel) then Exit;
Address := (Sender as TLabel).Caption;
ShellExecute(self.WindowHandle,'open',PChar(Address),nil,nil, SW_SHOWNORMAL);
end;
Edit:
If you do not want to have address in your caption, you can use Tag property to retrieve address and set caption to whatever you want:
procedure OnClickOnMyLinkTLabels(Sender : TObject);
var
Address : string;
begin
if NOT (Sender is TLabel) then Exit;
Address := GetAddresByTag( (Sender as TLabel).Tag );
ShellExecute(self.WindowHandle,'open',PChar(Address),nil,nil, SW_SHOWNORMAL);
end;
How you will implement GetAddresByTag is your choice. The most simple one is use an array of strings:
//in your form defintion
private
FAddresses : array of string;
function GetAddresByTag(id : integer): string;
begin
if (i<Low(FAddresses)) OR (I> High(FAddresses)) then
raise EXception.Create('wrong id sent!');
Result:= FAddresses[id];
end;
If your text is static, then you can still do this using labels. Lay out your entire text block INCLUDING the words you want as links. Set the label as transparent. Next, drop separate label components (also set to transparent) that will be the link. Change the color to clNavy, font style to fsunderline and the cursor to crHand. Then position the label OVER the existing text. Then write a onClick handler for each "link" label to perform your hot link.
While this is not optimal, it does work as long as you don't want to bold the text and are willing to keep the text the same font size. Of course this doesn't work so well if the block is dynamic, as you would have to calculate the position of the link labels in code, which is fairly complicated if you are using wordwrap. If not, you can use the canvas.textwidth and canvas.textheight methods to determine the necessary offset positions for your link labels.

Resources