Is there a way in Delphi XE2 to preserve the the InPlaceEditor's highlight in a StringGrid when the grid loses focus to another non-modal form?
My current StringGrid options are:
If not, I had hoped to use the code below to preserve a highlight of the current cell after losing focus, but am having some trouble with it leaving cells highlighted when they're no longer the current cell.
Do I need to add an "else" to the code below to change the color back to the original on non-selected cells? Any caveats?
procedure TForm1.sgMultiDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
begin
if (ACol = sgMulti.Col) and (ARow = sgMulti.Row) then
begin
sgMulti.Canvas.Brush.Color := clYellow;
sgMulti.Canvas.FillRect(Rect);
sgMulti.Canvas.TextRect(Rect, Rect.Left, Rect.Top, sgMulti.Cells[ACol, ARow]);
if gdFocused in State then
sgMulti.Canvas.DrawFocusRect(Rect); user
end;
end; { sgMultiDrawCell}
Edit: The screen capture below clarifies how it's behaving today. I want to current cell, when losing focus, to be more clear than the bottom screen capture
If you want to keep the goAlwaysShowEditor option enabled and highlight just the always displayed editor, you need the access to the InplaceEditor property. This needs to subclass your string grid class and change the color of the inplace editor, which is by default TCustomMaskEdit control class. In this code is shown, how to change the color of the inplace editor, depending on when the string grid is focused or not:
type
TStringGrid = class(Grids.TStringGrid)
private
procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
procedure CMExit(var Message: TCMExit); message CM_EXIT;
protected
function CreateEditor: TInplaceEdit; override;
end;
implementation
{ TStringGrid }
procedure TStringGrid.CMEnter(var Message: TCMEnter);
begin
inherited;
if Assigned(InplaceEditor) then
TMaskEdit(InplaceEditor).Color := $0000FFBF;
end;
procedure TStringGrid.CMExit(var Message: TCMExit);
begin
inherited;
if Assigned(InplaceEditor) then
TMaskEdit(InplaceEditor).Color := $0000A6FF;
end;
function TStringGrid.CreateEditor: TInplaceEdit;
begin
Result := inherited;
if Focused then
TMaskEdit(Result).Color := $0000FFBF
else
TMaskEdit(Result).Color := $0000A6FF;
end;
And the result with the focused and unfocused grid state:
Related
Using Delphi 10.3:
In an owner-drawn TComboBox with Style=csOwnerDrawFixed, I want the owner drawn items in the DropDown list to be different from the static part of the combo. To discriminate between the two cases, I check for odComboBoxEdit in the State parameter, as described here:
How to draw the static part of the combobox
procedure TStylePanel.TargetArrowComboDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
begin
if (odComboBoxEdit in State) then
begin
// Paint static control
end
else
begin
// Paint item in dropped down list
end;
end;
This works well as long as there's no custom VCL style active. However, with a custom style, this no longer works reliably. Checking the source in Vcl.StdCtrls.pas for TComboBoxStyleHook, it seems to me that the cause is in this combination:
procedure TComboBoxStyleHook.WMPaint(...)
procedure TComboBoxStyleHook.DrawItem(...)
When there's no edit handle (which is the case for csOwnerDrawFixed), DrawItem() assembles a TDrawItemStruct that will never contain ODS_COMBOBOXEDIT, as a result the CN_DRAWITEM handler will never have odComboBoxEdit set.
I could override TComboBoxStyleHook, but I'd need a way to detect if the item is the static item or an item in the list.
As a workaround, I check for Combo.DroppedDown, but that's not the same: even when dropped down, I want the static part to be painted differently than the items in the list.
So the question is, how can I detect (in the custom draw handler or in the style hook) that the custom drawn item is the static area rather than an item in the list?
I was able to get it working by adding a stylehook for TComboBox that unconditionally includes ODS_COMBOBOXEDIT. The assumption is that TComboBoxStyleHook.DrawItem is only called by TComboBoxStyleHook.WMPaint when it needs to custom draw the static item, the drop down list is not handled there. There seem to be no unwanted side effects.
type
TComboBoxStyleHookFix = class(TComboBoxStyleHook)
strict protected
procedure DrawItem(Canvas: TCanvas; Index: Integer; const R: TRect; Selected: Boolean); override;
end;
procedure TComboBoxStyleHookFix.DrawItem(Canvas: TCanvas; Index: Integer; const R: TRect; Selected: Boolean);
var
DIS: TDrawItemStruct;
begin
FillChar(DIS, SizeOf(DIS), 0);
DIS.CtlType := ODT_COMBOBOX;
DIS.CtlID := GetDlgCtrlID(Handle);
DIS.itemAction := ODA_DRAWENTIRE;
DIS.hDC := Canvas.Handle;
DIS.hwndItem := Handle;
DIS.rcItem := R;
DIS.itemID := Index;
DIS.itemData := SendMessage(ListHandle, LB_GETITEMDATA, 0, 0);
if (Control is TComboBox) and (TComboBox(Control).Style = csOwnerDrawFixed) then
DIS.itemState := ODS_COMBOBOXEDIT;
if Selected then
DIS.itemState := DIS.itemState or ODS_FOCUS or ODS_SELECTED;
SendMessage(Handle, WM_DRAWITEM, Handle, LPARAM(#DIS));
end;
procedure InitComboStyleHookFix();
begin
TCustomStyleEngine.RegisterStyleHook(TComboBox, TComboBoxStyleHookFix);
end;
I want to have a TEdit that reacts on a click like the Url bars in Chrome and Firefox. On first click they select all text and following clicks remove the selection as shown here:
My approach:
// This method is bound to the OnClick event
procedure TForm.edt_SearchClick(Sender: TObject);
begin
if edt_Search.SelLength > 0 then
edt_Search.SelLength := 0
else
edt_Search.SelectAll;
end;
This code doesn't work as expected as edt_Search.SelLength is always 0. The selection will always be cleared before the OnClick event is about to be triggered. I've already tried to put this code into the OnMouseUp and OnMouseDown events but the problem stays the same.
How can I solve it? Is there a way to do this without adding an additional boolean variable which saves the current state?
To select all text in a TEdit control when the control gains focus simply handle the OnEnter event and :
procedure TForm1.Edit1Enter(Sender: TObject);
begin
PostMessage(Edit1.Handle, EM_SETSEL, 0, -1);
end;
You cannot use Edit1.SelectAll since default behaviour (which happens after OnEnter) clears any selections in the Edit control. Posting the message ensures that it gets handled after the remaining default behaviour completes.
To fully emulate the address bar in those browsers, the field also deselects when exiting the control, so in OnExit :
procedure TForm.Edit1Exit(Sender: TObject);
begin
PostMessage(Edit1.Handle, EM_SETSEL, 0, 0);
end;
The browser field also allows you to select text when first entering, so in this case you need to be a bit more careful. As a hack you can do it with an interposer, but ideally you'd make a custom control :
type
TEdit = class(Vcl.StdCtrls.TEdit)
private
FDoEnterSelect : boolean;
end;
and then
procedure TForm1.Edit1Enter(Sender: TObject);
begin
Edit1.FDoEnterSelect := true;
end;
procedure TForm1.Edit1Exit(Sender: TObject);
begin
PostMessage(Edit1.Handle, EM_SETSEL, 0, 0);
end;
procedure TForm1.Edit1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Edit1.FDoEnterSelect and
(Edit1.SelLength = 0) then
PostMessage(Edit1.Handle, EM_SETSEL, 0, -1);
Edit1.FDoEnterSelect := false;
end;
procedure TForm1.Edit1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
Edit1.FDoEnterSelect := false;
end;
The KeyUp handler deals with the case of tabbing to the control. The only remaining odd case is if the edit control has TabOrder of zero and, therefore, is focused when the form is created (and therefore selected). This would affect the first click into the control only.
I want to show some rows from tcxgrid in different color (Depend upon column value ).
I did changes for it but its not getting reflected on grid after running my project.
procedure TfrmMessaging.cxGrid1DBTableView1CustomDrawCell(..);
Var
i : Integer;
begin
For i := 0 To cxGrid1DBTableView1.ViewData.RowCount - 1 Do
Begin
If cxGrid1DBTableView1.ViewData.Rows[i].Values[4] = '1' Then
Begin
cxGrid1.Canvas.Brush.Color := clRed;
End;
End;
end;
In above code I have used cxGrid1DBTableView1CustomDrawCell event of tcxgrid.
Thanks in advance.
If you are using a data-aware view (as it seems) you need to use the DataController instead of the ViewData to get to the records.
As stated in DevExpress help for TcxGridDBTableView (bold format is mine):
The TcxGridDBTableView object represents the data-aware version of the grid Table View. It inherits all functionality from its ancestor, except for data binding settings. The DataController.DataSource property of the TcxGridDBTableView provides the connection between the View and a TDataSet or its descendant.
Besides that, the OnCustomDrawCell event fires for every cell, so you do not need to iterate the rows.
Following code should help you:
procedure TfrmMessaging.cxGrid1DBTableView1CustomDrawCell(
Sender: TcxCustomGridTableView; ACanvas: TcxCanvas;
AViewInfo: TcxGridTableDataCellViewInfo; var ADone: Boolean);
begin
if Sender.DataController.GetValue(AViewInfo.GridRecord.RecordIndex, 4) = '1' then
ACanvas.Brush.Color := clRed;
end;
Normally the easiest path for stuff like that are cxStyles. Drop a style repository on the form, add one or more styles to it and assign them in the object inspector or in an event handler (OnGetContentStyle etc.).
One advantage over custom drawing is that styles are considered for various calculations while owner drawn cells aren't handled specially and sometimes aren't autosized correctly etc.
How I change the color of the grid
procedure TfrmNewOffer.GrdOffDetailViewRemarkCustomDrawCell(
Sender: TcxCustomGridTableView; ACanvas: TcxCanvas;
AViewInfo: TcxGridTableDataCellViewInfo; var ADone: Boolean);
var
backgroundColorCode: Variant;
textColorCode: Variant;
begin
inherited;
if assigned(AViewInfo) and assigned(AViewInfo.GridRecord) then
begin
backgroundColorCode := AViewInfo.GridRecord.Values[GrdOffDetailViewBackColorCode.Index];
textColorCode := AViewInfo.GridRecord.Values[GrdOffDetailViewTextColorCode.Index];
if not VarIsNull(backgroundColorCode) then
begin
ACanvas.Brush.Color := backgroundColorCode;
end;
if not VarIsNull(textColorCode) then
begin
ACanvas.Font.Color := textColorCode;
end;
end;
end;
I am placing checkboxes (TCheckBox) in a string grid (TStringGrid) in the first column. The checkboxes show fine, positioned correctly, and respond to mouse by glowing when hovering over them. When I click them, however, they do not toggle. They react to the click, and highlight, but finally, the actual Checked property does not change. What makes it more puzzling is I don't have any code changing these values once they're there, nor do I even have an OnClick event assigned to these checkboxes. Also, I'm defaulting these checkboxes to be unchecked, but when displayed, they are checked.
The checkboxes are created along with each record which is added to the list, and is referenced inside a record pointer which is assigned to the object in the cell where the checkbox is to be placed.
String grid hack for cell highlighting:
type
THackStringGrid = class(TStringGrid); //used later...
Record containing checkbox:
PImageLink = ^TImageLink;
TImageLink = record
...other stuff...
Checkbox: TCheckbox;
ShowCheckbox: Bool;
end;
Creation/Destruction of checkbox:
function NewImageLink(const AFilename: String): PImageLink;
begin
Result:= New(PImageLink);
...other stuff...
Result.Checkbox:= TCheckbox.Create(nil);
Result.Checkbox.Caption:= '';
end;
procedure DestroyImageLink(AImageLink: PImageLink);
begin
AImageLink.Checkbox.Free;
Dispose(AImageLink);
end;
Adding rows to grid:
//...after clearing grid...
//L = TStringList of original filenames
if L.Count > 0 then
lstFiles.RowCount:= L.Count + 1
else
lstFiles.RowCount:= 2; //in case there are no records
for X := 0 to L.Count - 1 do begin
S:= L[X];
Link:= NewImageLink(S); //also creates checkbox
Link.Checkbox.Parent:= lstFiles;
Link.Checkbox.Visible:= Link.ShowCheckbox;
Link.Checkbox.Checked:= False;
Link.Checkbox.BringToFront;
lstFiles.Objects[0,X+1]:= Pointer(Link);
lstFiles.Cells[1, X+1]:= S;
end;
Grid's OnDrawCell Event Handler:
procedure TfrmMain.lstFilesDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
var
Link: PImageLink;
CR: TRect;
begin
if (ARow > 0) and (ACol = 0) then begin
Link:= PImageLink(lstFiles.Objects[0,ARow]); //Get record pointer
CR:= lstFiles.CellRect(0, ARow); //Get cell rect
Link.Checkbox.Width:= Link.Checkbox.Height;
Link.Checkbox.Left:= CR.Left + (CR.Width div 2) - (Link.Checkbox.Width div 2);
Link.Checkbox.Top:= CR.Top;
if not Link.Checkbox.Visible then begin
lstFiles.Canvas.Brush.Color:= lstFiles.Color;
lstFiles.Canvas.Brush.Style:= bsSolid;
lstFiles.Canvas.Pen.Style:= psClear;
lstFiles.Canvas.FillRect(CR);
if lstFiles.Row = ARow then
THackStringGrid(lstFiles).DrawCellHighlight(CR, State, ACol, ARow);
end;
end;
end;
Here's how it looks when clicking...
What could be causing this? It's definitely not changing the Checked property anywhere in my code. There's some strange behavior coming from the checkboxes themselves when placed in a grid.
EDIT
I did a brief test, I placed a regular TCheckBox on the form. Check/unchecks fine. Then, in my form's OnShow event, I changed the Checkbox's Parent to this grid. This time, I get the same behavior, not toggling when clicked. Therefore, it seems that a TCheckBox doesn't react properly when it has another control as its parent. How to overcome this?
TStringGrid's WMCommand handler doesn't allow children controls to handle messages (except for InplaceEdit).
So you can use e.g. an interposed class (based on code by Peter Below) or draw controls by hands, as some people have adviced. Here is the code of the interposed class:
uses
Grids;
type
TStringGrid = class(Grids.TStringGrid)
private
procedure WMCommand(var AMessage: TWMCommand); message WM_COMMAND;
end;
implementation
procedure TStringGrid.WMCommand(var AMessage: TWMCommand);
begin
if EditorMode and (AMessage.Ctl = InplaceEditor.Handle) then
inherited
else
if AMessage.Ctl <> 0 then
begin
AMessage.Result := SendMessage(AMessage.Ctl, CN_COMMAND,
TMessage(AMessage).WParam, TMessage(AMessage).LParam);
end;
end;
In Delphi7 at least I do this:
You need to draw a checkbox on the cell, and keep it in sync with an array of boolean (here fChecked[]) that indicates the state of the checkbox in each row. Then, in the DrawCell part of the TStringGrid:
var
cbstate: integer;
begin
...
if fChecked[Arow] then cbState:=DFCS_CHECKED else cbState:=DFCS_BUTTONCHECK;
DrawFrameControl(StringGrid.canvas.handle, Rect, DFC_BUTTON, cbState);
...
end;
To get the checkbox to respond to the space-bar, use the KeyDown event, and force a repaint:
if (Key = VK_SPACE) And (col=ColWithCheckBox) then begin
fChecked[row]:=not fChecked[row];
StringGrid.Invalidate;
key:=0;
end;
A similar approach is needed for the OnClick method.
Can u use VirtualTreeView in toReportMode (TListView emulating) mode instead of grid ?
Can u use TDBGrid over some in-memory table like NexusDB or TClientDataSet ?
Ugly approach would be presenting checkbox like a letter with a custom font - like WinDings or http://fortawesome.github.com/Font-Awesome
This latter is most easy to implement, yet most ugly to see and most inflexible to maintain - business logic gets intermixed into VCL event handlers
I want to restrict users (based on special condition) to open a tab or not in a page control. ie, the user can click on the tab but it will not be displayed to him. Instead, a message will show to him that "he don't have the access right to see such tab".
On what event I should write the checking code, and what tab property (of TPageControl component) will allow/block user to enter such tab?
In an ideal world you would set AllowChange to False from theOnChanging event to block a page change. However, this does not appear to be viable because I can find no way of discerning, from within OnChanging, which page the user is trying to select.
Even looking at the underlying Windows notification seems to offer little hope. The TCN_SELCHANGING notification identifies the control, but not says nothing about the pages involved, so far as I can tell.
The best I can come up with is to use OnChanging to note the current active page and then do the hard work in OnChange. If the selected page has been changed to something undesirable, then just change it back.
procedure TForm1.PageControl1Changing(Sender: TObject; var AllowChange: Boolean);
begin
FPreviousPageIndex := PageControl1.ActivePageIndex;
end;
procedure TForm1.PageControl1Change(Sender: TObject);
begin
if PageControl1.ActivePageIndex=1 then begin
PageControl1.ActivePageIndex := FPreviousPageIndex;
Beep;
end;
end;
Rather messy I know, but it has the virtue of working!
The OnChanging event does not allow you to determine which tab is being selected, because Windows itself does not report that information. What you can do, however, is subclass the TPageControl.WindowProc property to intercept messages that are sent to the TPageControl before it processes them. Use mouse messages to determine which tab is being clicked on directly (look at the TPageControl.IndexOfTabAt() method), and use keyboard messages to detect left/right arrow presses to determine which tab is adjacent to the active tab (look at the TPageControl.FindNextPage() method).
Use the OnChanging event of the page control.
procedure TForm1.PageControl1Changing(Sender: TObject; var AllowChange: Boolean);
begin
if (self.PageControl1.TabIndex= 1)and
(NotAllowUser = 'SomePerson') then
begin
AllowChange:= False;
ShowMessage('Person not allow for this Tab');
end;
end;
Ok, the PageControle1.TabIndex is the activepageindex and not the one i want to select.
How can i get the clicked Page.
procedure TForm1.PageControl1Changing(Sender: TObject; var AllowChange: Boolean);
var
P: TPoint;
NewTabIndex: Integer;
begin
P := PageControl1.ScreenToClient(Mouse.CursorPos);
NewTabIndex := PageControl1.IndexOfTabAt(P.X, P.y);
if (NewTabIndex= 1) then
begin
AllowChange:= false;
Beep
end;
end;
New Attempt
TMyPageControl = Class(TPageControl)
private
FNewTabSheet: TTabSheet;
FOnMyChanging: TMyTabChangingEvent;
procedure SetOnMyChanging(const Value: TMyTabChangingEvent);
procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY;
procedure CMDialogKey(var Message: TCMDialogKey); message CM_DIALOGKEY;
protected
function CanChange: Boolean; Override;
public
property OnMyChanging: TMyTabChangingEvent read FOnMyChanging write SetOnMyChanging;
End;
{ TMyPageControl }
function TMyPageControl.CanChange: Boolean;
begin
Result := True;
if Assigned(FOnMyChanging) then FOnMyChanging(Self, FNewTabSheet ,Result);
end;
procedure TMyPageControl.CMDialogKey(var Message: TCMDialogKey);
begin
if (Focused or Windows.IsChild(Handle, Windows.GetFocus)) and
(Message.CharCode = VK_TAB) and (GetKeyState(VK_CONTROL) < 0) then
begin
FNewTabSheet := FindNextPage(ActivePage, GetKeyState(VK_SHIFT) >= 0,True);
SelectNextPage(GetKeyState(VK_SHIFT) >= 0);
Message.Result := 1;
end else
inherited;
end;
procedure TMyPageControl.CNNotify(var Message: TWMNotify);
var
P: TPoint;
NewTabIndex: Integer;
begin
with Message do
case NMHdr.code of
TCN_SELCHANGE:
Change;
TCN_SELCHANGING:
begin
Result := 1;
P := self.ScreenToClient(Mouse.CursorPos);
NewTabIndex := self.IndexOfTabAt(P.X, P.y);
FNewTabSheet:= self.Pages[NewTabIndex];
if CanChange then Result := 0;
end;
end;
end;
procedure TMyPageControl.SetOnMyChanging(const Value: TMyTabChangingEvent);
begin
FOnMyChanging := Value;
end;
You can show tab and effectively disable changing in OnChanging event of TPageControl. All you need to do is set AllowChange var to False.
procedure TForm1.PageControl1(Sender: TObject; var AllowChange: Boolean);
begin
AllowChange := MyCondition;
if MyCondition
ShowMessage('User doesn''t have permission to see this tab.');
end
Sometimes it is better just to hide unwanted TabSheets with something like this:
TabSheetNN.TabVisible:=Somecondition;
than trying to prevent switching to these tabs.
Sure, it would be better if Sender in OnChanging event will be TabSheet , not TPageControl.