Checkbox handling in version 5.0.0 of VirtualTrees.pas appears broken when toThemeAware is enabled. Nodes that are csUncheckedNormal are drawn as checked + hot.
To correctly paint an unchecked, themed checkbox using DrawElement, the Details record must be : Element = teButton, Part = 3, and State = 5. However, VirtualTrees.pas ends up calling DrawElement with State = 1 when a node is set to csUncheckedNormal.
There seems to be a good deal of indirection and extra constants declared in VirtualTrees, so I'm not sure how best to fix this. Ideas welcomed...
(Even the minimal code to get a TVirtualStringTree on screen and filled with some data is a bit lengthy to post here. Aside from the basics, all that's needed to reproduce this is to enable toCheckSupport in TreeOptions.MiscOptions, and set Node.CheckType := ctTriStateCheckBox in the InitNode callback.)
Well, since I think the VirtualTreeView does not count with the VCL styles when porting to delphi XE2, this might light up to solve your problem. You have to get element details before you draw it, otherwise you'll get something like this (it's the simulation of how the VirtualTreeView paint check box states). Notice the different order and the artifacts; it's the result of the same code once with VCL styles disabled, second time enabled:
Quite strange I know, but I can't answer you why is this happening. I can just tell you that you should call the TThemeServices.GetElementDetails or optionally calculate the state index by your own to get the element rendering to work properly. You may try to use the following fix:
procedure TBaseVirtualTree.PaintCheckImage(Canvas: TCanvas;
const ImageInfo: TVTImageInfo; Selected: Boolean);
var
// add a new variable for calculating TThemedButton state from the input
// ImageInfo.Index; I hope ImageInfo.Index has the proper state order
State: Integer;
begin
...
case Index of
0..8: // radio buttons
begin
// get the low index of the first radio button state and increment it by
// the ImageInfo.Index and get details of the button element
State := Ord(TThemedButton(tbRadioButtonUncheckedNormal)) + Index - 1;
Details := StyleServices.GetElementDetails(TThemedButton(State));
end;
9..20: // check boxes
begin
// get the low index of the first check box state and increment it by
// the ImageInfo.Index and get details of the button element
State := Ord(TThemedButton(tbCheckBoxUncheckedNormal)) + Index - 9;
Details := StyleServices.GetElementDetails(TThemedButton(State));
end;
21..24: // buttons
begin
// get the low index of the first push button state and increment it by
// the ImageInfo.Index and get details of the button element
State := Ord(TThemedButton(tbPushButtonNormal)) + Index - 21;
Details := StyleServices.GetElementDetails(TThemedButton(State));
end;
else
Details.Part := 0;
Details.State := 0;
end;
...
end;
I've tested this for all check types and it works for me.
Related
I'm using a TListBox in Firemonkey, and I'm facing a strange issue when it comes to dynamically showing/hiding items. This includes both Delphi XE7 and XE8. The setup, there is a TPopupBox at the top of the form, where user chooses one of the items listed. Depending on which was chosen, the TListBox should show only certain TListBoxItems, and hide the rest. Part of this consists of resizing each list item height to 0 when not visible (otherwise it would leave an ugly gap between the items).
The problem is that very randomly and spontaneously (no pattern), selecting an item in this TPopupBox (calling OnChange which modifies visibility), produces an EArgumentOutOfRangeException at an unknown point. The code breaks in System.Generics.Collections.TListHelper.SetItemN() on the first line calling CheckItemRangeInline(AIndex); Within there, it's simply:
procedure TListHelper.CheckItemRangeInline(AIndex: Integer);
begin
if (AIndex < 0) or (AIndex >= FCount) then
raise EArgumentOutOfRangeException.CreateRes(#SArgumentOutOfRange);
end;
The exception continues to be raised over and over and over again with no end (starts with 4 in a row). When I use the debugger to step in, I can never manage to get it to happen.
There are a couple common procedures used here which control item visibility:
//lstTrans = TListBox
//Iterates through all items and hides everything
procedure TfrmMain.HideTransItems;
var
X: Integer;
begin
for X := 0 to lstTrans.Count-1 do begin
lstTrans.ListItems[X].Visible:= False;
end;
end;
//Sets height of visible items to 42, invisible items to 0
procedure TfrmMain.ResetTransHeights;
var
X: Integer;
LI: TListBoxItem;
begin
for X := 0 to lstTrans.Count-1 do begin
LI:= lstTrans.ListItems[X];
if LI.Visible then
LI.Height:= 42
else
LI.Height:= 0;
end;
end;
Then, when choosing something in the TPopupBox:
//cboTrans = TPopupBox
procedure TfrmMain.cboTransChange(Sender: TObject);
procedure E(AItem: TListBoxItem);
begin
AItem.Visible:= True;
end;
begin
HideTransItems; //Make all list items invisible
case cboTrans.ItemIndex of
0: begin
E(lbSomeListBoxItem);
E(lbSomeOtherItem);
//More calls to "E"
end;
1: begin
E(lbSomeListBoxItem2);
//More calls to "E"
end;
//More indexes
end;
ResetTransHeights; //Adjust visible list item heights to be seen
end;
(The full procedure is just a lot of the exact same types of calls, too much to post here)
Nowhere am I adding or removing items - only changing visibility
There are no events triggered which might be causing some faulty loop
The TPopupBox is located outside of the TListBox
Each TListBoxItem has one or two controls (yet it doesn't matter which ones are being shown/hidden)
Selecting an item in this TPopupBox may work one time, yet fail the next
Sometimes it occurs the first time I show/hide these items, sometimes it takes 20-30 tries
Never able to reproduce while stepping through in Debug
Why would I be receiving this exception, and how do I fix it?
Why would I be receiving this exception, and how do I fix it?
You know why you are receiving it. You are accessing an array with an index that lies outside the valid range.
The question is where that index is. If you cannot readily reproduce then you need to debug to gather diagnostics. On Windows you'd use a tool like madExcept to gather information. Most useful would be the call stack that led to the error.
If you don't have madExcept or a similar tool at hand use trace logging. Instrument your code so that it logs information that allows you to determine which access of the list is out of bounds. You'll likely end up iterating around this as you narrow down the search.
Finally, once you identify which code leads to the error, usually the problem becomes apparent.
I had the same issue when I was animating the height of a TListBoxItem.
The issue only occurred when I was changing the Height of a Selected item. I implemented Jerry Dodge's solution of setting the height to 0.01 instead of 0 which fixed the issue.
Delphi Berlin Code
{Delphi Berlin}
ItemIndex := 0;
Item := ListBox.ItemByIndex(ItemIndex);
Height := Item.Height;
FloatAnimation := TFloatAnimation.Create(nil);
FloatAnimation.Parent := Item;
FloatAnimation.PropertyName := 'height'
FloatAnimation.StartValue := Height;
FloatAnimation.StopValue := 0.01; {Setting to 0 causes "Argument out of range" if the item is selected}
FloatAnimation.Start;
I am using Delphi 7 (Yes, I hear the guffaws). I have a tabbed notebook that I want certain controls to appear only in a sequence where the prior control is finished correctly. For each page in the notebook, I have a named sheet. And for the controls on that sheet, I use the tag property to determine whether they are visible at each step. Some steps result in one new control showing, some steps have as many as five controls popping into view. I thought to simply iterate through the controls on any tab sheet that's in view and turn off anything with a tag greater than the current step value. On the page in question, there appear to be 23 controls in all, some labels that are always in view, some edit fields that pop up into view and some arrow-shaped buttons for advancing when a newly popped up field gets changed. Seemed simple enough, except I kept generating Index out of range errors. The sequence would shut down with out a detailed error message for EurekaLog, not anything opened up that should have been. I finally 'resolved' the issue by plugging in a check for the NAME of the control I knew was last in the list and quitting the loop at that point. I also added the extra test for Kounter.tag <> zero to avoid leaving the Submit and Cancel buttons on in some routes. Ideas why the Kounter just kept on past 23?
procedure TFrmMain.VizToggleWTP;
var
kounter: Integer;
kontrol: TControl;
Kontrolz: Integer;
begin
Kontrolz := sheetPrintouts.ControlCount;
for Kounter := 1 to Kontrolz
do begin
// To avoid index error, check for the Cancel Button and exit at that point
if sheetPrintouts.Controls[kounter].Name = 'BtnCancelwtp'
then Break;
if (sheetPrintouts.Controls[Kounter]) is TNXEdit
then begin
kontrol := TNXEdit(sheetPrintouts.Controls[Kounter]);
kontrol.visible := (kontrol.Tag <= wtpStep);
end;
if (sheetPrintouts.Controls[Kounter]) is TJvShapedButton
then begin
kontrol := TJvShapedButton(sheetPrintouts.Controls[Kounter]);
kontrol.visible := ((kontrol.Tag <= wtpStep) and (kontrol.Tag <> 0));
end;
end;
end;
You need to replace
for Kounter := 1 to Kontrolz do
with
for Kounter := 0 to Kontrolz-1 do
since the Controls array is zero-based.
For instance, if there are three controls, they are indexed 0, 1, 2 and not 1, 2, 3.
My program is in a post release state so please bear with me.
Scenario
My program is based on multiple layouts for different pages of different function for an office data management system (vehicle maintenance oriented). A major category of those functions is obviously data entry. I have used different styles to suite different audiences.
Getting to the point, one of the interfaces has excel styled grids and 3 buttons for Print/Save/Reset functions. I use FastReports for the form prints.
I am developing a custom class for the grid columns to make them accommodate a predefined list of controls instead of their cells on the fly but for now i just made the required controls children of the cells in code.
The page has 3 sections (layouts);
The top one is a kind of a purpose (Add/Modify/Add Partial) selector specific to all pages and may not be visible where not required.
The Middle one is a control for receiving receipt nos of the forms to be modified, their information embedded in others etc. Its mostly on every page but not all.
The Last one has the page's content which is the grid and the 3 buttons as mentioned earlier.
Code
This is a snippet of code for displaying one of the problematic pages. It is executed when all data processing has been done with and the server OKs the transition.
Legend
AState : State Machine State Variable; Signifies the current state of the page displayed.
AMode : State Machine State Enumerator; Signifies the mode of the application as a whole, e.g. Booking (Data entry) etc. I have skipped the code involving this as it gets skipped during the transition of AState for this problem to occur.
fMode : Same as above but its the main field of the form for the purpose.
UI_CA_Controls1 : The layout which contains the booking mode's purpose selector (Combo List Box).
EV_Mode : A variable for convenience; It stores the Item Index of the purpose selector.
UI_CA_Grid : The Layout contained in UI_CA_Content and itself contains UI_CA_FieldGrid (TGrid).
fEditColumn : The second column of the grid having TEdits.
fGridDataset : The grid associated TStringList.
//
procedure TUI.SetFormState ( AState : Byte; AMode : TMode = UIM_Unselected );
var
EV_Mode, I : Byte;
begin
// ---------------------------------------------------------------------------
fFormState := AState;
// The children of the grid cells
fCalEdit1.Parent := nil; // Calender Edits
fCalEdit2.Parent := nil;
fVehicleClass.Parent := nil; // Combo List Boxes
fEmployee1.Parent := nil;
fEmployee2.Parent := nil;
fEmployee3.Parent := nil;
fEmployee4.Parent := nil;
// ---------------------------------------------------------------------------
if AState = 0 then
begin
for I := 0 to 20 do
DPCM.fGridDataset.Strings [I] := ''; // The Grid Associated TStringList
UI_CA_ReceiptNo.ReadOnly := False;
UI_CA_ReceiptNo.Text := '';
end;
// ---------------------------------------------------------------------------
UI_CA_Content.BeginUpdate;
case fMode of
// Skipped unrelated modes
UIM_Booking :
begin
UI_CA_Controls1.Visible := True;
EV_Mode := UI_CA_EV_ModeSelect.ItemIndex;
// -----------------------------------------------------------------------
if fFormState = 0 then
begin
// Skipped handling of other EV_Mode values
if EV_Mode < 7 then
begin
UI_CA_ReceiptControl.Visible := True;
UI_CA_Content.Visible := False;
end;
end
// -----------------------------------------------------------------------
else if fFormState = 1 then // The problematic area
begin
if ( EV_Mode = 3 ) or ( EV_Mode = 4 ) then
begin
UI_CA_FieldGrid.RowCount := 6;
UI_CA_Grid.Height := 160;
fCalEdit1.Parent := fEditColumn.CellControlByRow ( 0 );
fCalEdit1.Date := Date;
fCalEdit2.Parent := nil;
fVehicleClass.Parent := fEditColumn.CellControlByRow ( 2 );
fVehicleClass.ItemIndex := 0;
end;
UI_CA_Content.Visible := True;
end;
end;
// -------------------------------------------------------------------------
end;
// ---------------------------------------------------------------------------
// Workaround 1
if UI_CA_Content.Visible then
begin
UI_CA_FieldGrid.UpdateColumns;
UI_CA_Content.EndUpdate;
UI_CA_FieldGrid.SetFocus;
UI_CA_C2_Reset.SetFocus;
UI_CA_C2_Print.SetFocus;
UI_CA_C2_Save.SetFocus;
UI_CA_FieldGrid.SetFocus;
end
else UI_CA_Content.EndUpdate;
end;
The Problem
The problem is that whenever the receipt section is displayed the content section doesn't get displayed on the spot. The behavior is such that when i hover the mouse where those children controls and the 3 buttons should be they get displayed but the grid gets displayed when I click on it only.
The problem has arose by itself with no change in UI code which has baffled me for 3 days now. I have only made optimizations to protocol and data handling on the network side (Separate Data Module).
Sequence
The user wants to modify already booked vehicle's data.
The user enters the booking receipt no. ( AState = 0, AMode = UIM_Booking )
The client query's the server and the server replies with the complete dataset if exists.
The client takes the data and copies it in the strings of the Grid associated TStringlist and the children fields.
The client doesn't display the grid with the data and the 3 buttons. ( AState = 1, AMode = UIM_Booking )
What have I tried till now
Used BeginUpdate/EndUpdate which made it worse with alignment artifacts.
Used SetFocus on the grid and the buttons which resulted in random display of some of them and sometimes complete display but not every time.
Used Application.ProcessMessages with no change rather the UI thread sometimes just got stuck in it never to return. Used it in a separate thread, calling it every second with no change.
Used a separate thread for the method with even more issues.
Back tracked and restored old working code with no change (made me really angry).
Update 1: I have tried to make the grid invisible and then visible at the end of the code. Now some cells of the grid get shown randomly.
Workaround 1
The grid and buttons can be shown when the SetFocus method is called for each of them.
The order of the calls is erratic for the buttons. Like I had to call reset first and then print and save's SetFocus method otherwise only one of them got displayed.
There is a split second realignment glitch which shows the controls resizing but i think that's ignorable.
Workaround 2
Do queued repainting rather than immediate. It doesn't have any caveats but the catch is after all that there is a delay in between every repaint.
Link: https://stackoverflow.com/a/8424750/1388291
So if you people have any suggestions, I'll be really grateful.
I have a DataSet (TZQuery), which has several boolean fields, that have TDBCheckBoxes assigned to them.
These CheckBoxes have "OnClick" events assigned to them and they are triggered whenever I change field values (which are assigned to checkboxes).
The problem is that I do not need these events triggerred, during many operations i do with the dataset.
I've tried calling DataSet.DisableControls, but then events are called right after i call DataSet.EnableControls.
So my question is - is there a way to disable triggering Data-aware controls events.
Edit (bigger picture):
If an exception happens while let's say saving data, i have to load the default values (or the values i've had before saving it). Now while loading that data, all these events (TDBCheckBoxes and other data-aware controls) are triggered, which do all sorts of operations which create lag and sometimes even unwanted changes of data, i'm looking for an universal solution of disabling them all for a short period of time.
Building on Guillem's post:
Turn off everything:
Traverse each component on the form with the for-loop, shown below, changing the properties to the desired value.
If you want to later revert back to the original property values, then you must save the original value (as OldEvent is used below.)
Edit: The code below shows the key concept being discussed. If components are being added or deleted at run-time, or if you'd like to use the absolutely least amount of memory, then use a dynamic array, and as Pieter suggests, store pointers to the components rather than indexing to them.
const
MAX_COMPONENTS_ON_PAGE = 100; // arbitrarily larger than what you'd expect. (Use a dynamic array if this worries you.
var
OldEvent: Array[0.. MAX_COMPONENTS_ON_PAGE - 1] of TNotifyEvent; // save original values here
i: Integer;
begin
for i := 0 to ComponentCount - 1 do
begin
if (Components[i] is TCheckBox) then
begin
OldEvent[i] := TCheckBox(Components[i]).OnClick; // remember old state
TCheckBox(Components[i]).OnClick := nil;
end
else if (Components[i] is TEdit) then
begin
OldEvent[i] := TEdit(Components[i]).OnClick; // remember old state
TEdit(Components[i]).OnClick := nil;
end;
end;
Revert to former values
for i := 0 to ComponentCount - 1 do
begin
if (Components[i] is TCheckBox) then
TCheckBox(Components[i]).OnClick := OldEvent[i]
else if (Components[i] is TEdit) then
TEdit(Components[i]).OnClick := OldEvent[i];
end;
There may be a way to fold all of the if-statements into one generic test that answers "Does this component have an OnClickEvent" -- but I don't know what it is.
Hopefully someone will constructively criticize my answer (rather than just down voting it.) But, hopefully what I've shown above will be workable.
One way to do this is following:
var
Event : TNotifyEvent;
begin
Event := myCheckbox.OnClick;
try
myCheckbox.OnClick := nil;
//your code here
finally
myCheckbox.OnClick := Event;
end;
end;
HTH
The internal design of the TCustomCheckBox is that it triggers the Click method every time the Checked property if changed. Be it by actually clicking it or setting it in code. And this is happening here when you call EnableControls because the control gets updated to display the value of the linked field in your dataset.
TButtonControl (which is what TCustomCheckBox inherits from) has the property ClicksDisabled. Use this instead of (or in addition to) the DisableControls/EnableControls call. Unfortunately it is protected and not made public by TCustomCheckBox but you can use a small hack to access it:
type
TButtonControlAccess = class(TButtonControl)
public
property ClicksDisabled;
end;
...
TButtonControlAccess(MyCheckBox1).ClicksDisabled := True;
// do some dataset stuff
TButtonControlAccess(MyCheckBox1).ClicksDisabled := False;
Of course you can put this into a method that checks all components and sets this property if the control inherits from TCustomCheckBox or some other criteria.
I have created one form in delphi 7 and added one combobox on it. The combobox contains the list of items. I dont want that user can enter the value to Combobox so i have set
combobox.style := csDropDownList;
But thorugh code i want to use combobox.text := 'New Item'; but its not working. Note that the text I want to show is not in the list of items and I don't want to add it there. Please is any solution to this?
No, this is simply not the way the Windows combobox control works.
However, if you insist, and you don't care that your users will get confused, you can set Style to csDropDown and then do
procedure TForm1.ComboBox1KeyPress(Sender: TObject; var Key: Char);
begin
Key := #0;
end;
as the combobox' OnKeyPress event. Then the user cannot enter text manually, but can only choose from the items in the list. However, you can still set the text to anything you like (even if it isn't in the list) by setting the Text property:
ComboBox1.Text := 'Sample';
Set the ItemIndex property. You can get ComboBox.Items.IndexOf('New Item') to get the index of that text, if you don't already know it.
Combobox.ItemIndex := Combobox.Items.IndexOf('New item');
Below sample code demonstrates how you can draw custom text in response to a WM_DRAWITEM message sent to the ComboBox control's parent window (this should be the form for the sample to work, otherwise subclassing controls or full drawing of items of the control would be necessary).
To receive this message set the Style property of the control to 'csOwnerDrawFixed', but do not put a handler for the OnDrawItem event so that default drawing should be applied in all other cases that we intervene drawing.
The sample sets a text when ItemIndex is -1, but it can be adapted/tweaked otherwise. Note that the drawing code is not complete or accurate, the sample just demonstrates a way how it can be done:
type
TForm1 = class(TForm)
ComboBox1: TComboBox;
[..]
private
procedure WMDrawItem(var Msg: TWMDrawItem); message WM_DRAWITEM;
end;
[...]
procedure TForm1.WMDrawItem(var Msg: TWMDrawItem);
var
Font: HFONT;
begin
inherited;
if (Msg.Ctl = ComboBox1.Handle) and (Msg.DrawItemStruct.itemID = $FFFFFFFF) and
((Msg.DrawItemStruct.itemAction and ODA_DRAWENTIRE) = ODA_DRAWENTIRE) then begin
Font := SelectObject(Msg.DrawItemStruct.hDC, ComboBox1.Canvas.Font.Handle);
SelectObject(Msg.DrawItemStruct.hDC, GetStockObject(DC_BRUSH));
if (Msg.DrawItemStruct.itemState and ODS_SELECTED) = ODS_SELECTED then begin
SetDCBrushColor(Msg.DrawItemStruct.hDC, ColorToRGB(clHighlight));
SetBkColor(Msg.DrawItemStruct.hDC, ColorToRGB(clHighlight));
SetTextColor(Msg.DrawItemStruct.hDC, ColorToRGB(clHighlightText));
end else begin
SetDCBrushColor(Msg.DrawItemStruct.hDC, ColorToRGB(clWindow));
SetBkColor(Msg.DrawItemStruct.hDC, ColorToRGB(clWindow));
SetTextColor(Msg.DrawItemStruct.hDC, ColorToRGB(clWindowText));
end;
FillRect(Msg.DrawItemStruct.hDC, Msg.DrawItemStruct.rcItem, 0);
TextOut(Msg.DrawItemStruct.hDC, 4, 4, '_no_selected_item_', 18);
SelectObject(Msg.DrawItemStruct.hDC, Font);
end;
end;
I think you want the normal thing, to display something in the ComboBox when no selection has yet been made. Instant of a blank rectangle. Imagine a form full of blank comboboxes... ;)
What I've seen most programmers do is have the first item as the title to display in the ComboBox.
So, in FormCreate (after you've populated the ComboBox), you set its ItemIndex to 0, and this displays the title.
In its OnChange event you can choose to take no action if item 0 is selected ("real" items then have base 1 for index), or get ItemIndex-1 and skip action if < 0.
Must be a super common complaint from everyone who has used Comboboxes the first time. I can't understand how none of the coders recognize it.
All Borland et al would have had to do was to initialize a new ComboBox with ItemIndex=0 and the confusion would have been gone. It's certainly not obvious that you have to set index 0 - since you see the blank line when clicked, the logical conclusion is that it has index 0. Probably they wanted to give designers the option to add a label outside the combobox instead.