how to read registry key for certain condition only? - delphi

i have create 5 dynamic buttons in 1 row and store the button info (caption, isActive, etc) in registry. It shows the button in form when the IsActive = TRUE from registry. The result is as below (each button indicate by a * symbol):
*****
When i set the IsActive = FALSE for button2 and button4, the button being remove and left the space as below:
* ** *
Any idea to solve this problem? The source code is as below:
procedure TfrmPOS.CreateDynamicBtn;
var
Reg : TRegIniFile;
lstKey : TStringList;
sKeyName : String;
bActive : boolean;
btn1 : TBitBtn;
i, k, iIcon : integer;
begin
lstKey := TStringList.Create;
Reg := TRegIniFile.Create;
try
//clear bitbtn
if ScrollBox2.ControlCount > 0 then begin
for k := ScrollBox2.ControlCount - 1 downto 0 do begin
with ScrollBox2.Controls[k] AS TBitBtn do begin
Free;
end;
end;
end;
sKeyName := Sysmem.RegKeyRoot+'\POSConfig\ItemSetting\';
Reg := TRegIniFile.Create(sKeyName);
Reg.GetKeyNames(lstKey); //button1, button2,...
for i := 0 to lstKey.Count - 1 do begin
Reg.OpenKeyReadOnly(sKeyName);
bActive := Reg.ReadBool(lstKey.Strings[i], 'IsActive', TRUE);
if bActive = TRUE then begin
//create dynamic bitbtn
btn1 := TBitBtn.Create(self);
btn1.Parent := ScrollBox2;
btn1.Height := 82;
btn1.Width := 82;
btn1.Left := ((i mod 5) * btn1.Width);
btn1.Top := (Trunc((i div 5)) * btn1.Height);
btn1.Caption := Reg.ReadString(lstKey.Strings[i], 'Caption', '');
iIcon := Reg.ReadInteger(lstKey.Strings[i], 'IconImage', 0);
imglstIcon.GetBitmap(iIcon, btn1.Glyph);
btn1.Layout := blGlyphTop;
btn1.Name := lstKey.Strings[i];
btn1.OnClick := OnButtonClick;
end;
Reg.CloseKey;
end;
finally
lstKey.Free;
Reg.Free;
end;
end;

I suspect you wonder why the space for the second button is still there, instead of the third button filling that area.
It's because you're setting the Left properties for the buttons as though all the buttons were there:
btn1.Left := ((i mod 5) * btn1.Width);
When i = 1, you skip over it because that button is invisible. But when i = 3, you calculate its position the same as you would have if button 2 had been visible. Keep a visible-button counter separate from your list iterator, and use it to position your buttons:
BtnIndex := 0;
Reg.OpenKeyReadOnly(sKeyName);
for i := 0 to lstKey.Count - 1 do begin
bActive := Reg.ReadBool(lstKey.Strings[i], 'IsActive', TRUE);
if bActive then begin
//create dynamic bitbtn
btn1 := TBitBtn.Create(self);
btn1.Parent := ScrollBox2;
btn1.SetBounds(BtnIndex mod 5 * 82, BtnIndex div 5 * 82, 82, 82);
Inc(BtnIndex);
There are better ways to do what you want. If you have a sufficiently recent version of Delphi, use a TFlowPanel or TGridPanel. They will arrange your buttons next to each other for you automatically. If your Delphi version didn't come with that control, then try a TToolBar instead and fill it with TToolButton controls.
Your question actually had nothing to do with the registry, but you can make better use of the registry anyway. There's no need to keep re-opening the same key every time. The value of sKeyName doesn't change inside the loop, so open the key once before you enter the loop (as shown above) and then just leave it open for as long as you need it.

Related

Programmatically check a custom treeview checkbox

I'm trying to programatically check a custom checkbox in a treeview. What I mean by custom, is that I call the below code to enable these checkboxes:
SetWindowLong(TreeView1.Handle, GWL_STYLE, GetWindowLong(TreeView1.Handle, GWL_STYLE) or TVS_CHECKBOXES)
I tried the below code to check it, but it did not work.
Node := TreeView1.Selected;
TVItem.mask := TVIF_STATE;
TVItem.hItem := Node.ItemId;
TreeView_GetItem(Node.TreeView.Handle, TVItem);
TVItem.stateMask := TVIS_CHECKED;
TVItem.mask := TVIS_CHECKED;
Thanks in advance
You have your state mask wrong, there's no TVIS_CHECKED state mask (in fact there is no TVIS_CHECKED, more on that later). Check boxes are managed through an image list, this is explained in the documentation.
Additionally, of course, you have to call TreeView_SetItem:
const
TVIS_CHECKED = 2 shl 12;
var
Node: TTreeNode;
TVItem: TTVItem;
begin
Node := TreeView1.Selected;
if Assigned(Node) then begin
TVItem.mask := TVIF_STATE;
TVItem.hItem := Node.ItemId;
TreeView_GetItem(Node.TreeView.Handle, TVItem);
TVItem.stateMask := TVIS_STATEIMAGEMASK;
TVItem.state := TVIS_CHECKED;
TreeView_SetItem(Node.TreeView.Handle, TVItem);
end;
end;
Normally I'd advise to call TreeView_SetCheckState but the VCL has got a weird error in the translation of the macro.
This is the macro in the header:
#define TreeView_SetCheckState(hwndTV, hti, fCheck) \
TreeView_SetItemState(hwndTV, hti, INDEXTOSTATEIMAGEMASK((fCheck)?2:1), TVIS_STATEIMAGEMASK)
where
#define INDEXTOSTATEIMAGEMASK(i) ((i) << 12)
This is why the made-up TVIS_CHECKED is $2000, the define shifts 2 12 bits left when fCheck is true (2 is the index of the checked image, 1 is unchecked).
This is VCL's translation:
function TreeView_SetCheckState(hwndTV: HWND; hti: HTreeItem; fCheck: BOOL): UINT;
var
LState: UINT;
begin
if IndexToStateImageMask(Integer(fCheck)) = 0 then
LState := 1
else
LState := 2;
Result := TreeView_SetItemState(hwndTV, hti, LState, TVIS_STATEIMAGEMASK);
where IndexToStateImageMask is
Result := I shl 12;
Strangely, the VCL shifts fCheck 12 bits and then calls TreeView_SetItemState with a state that makes no sense for a state image mask (TVIS_FOCUSED (1), TVIS_SELECTED (2)).
This is XE2, I suggest to test the macro first if you are working with a later version.
What do you have TVIS_CHECKED defined as? It should be:
const
TVIS_CHECKED = $2000;
Then, assuming Value is a Boolean of whether or not the item is checked:
FillChar(TVItem, SizeOf(TVItem), 0);
TVItem.hItem := Node.ItemId;
TVItem.mask := TVIF_STATE;
TVItem.stateMask := TVIS_STATEIMAGEMASK;
if Value then
TVItem.state := TVIS_CHECKED
else
TVItem.state := TVIS_CHECKED shr 1;
TreeView_SetItem(Node.Handle, TVItem);

Steema TeeChart Horizontal Bar Series. How to use Stacked100?

I wish to show a number of stacked values in a horizontal bar series. I can show the values stacked with their individual values OK, but I am unable to show them as mbStacked100 (so that the values take up 100% of the graph width) I have several values in the series, each with a corresponding color.
This code works to add the individual values, but I have not been able to successfully use mbStacked100 to show the series as a percentage rather than the individual values.
procedure TForm4.Button1Click(Sender: TObject);
var
Rnd : Integer;
i : Integer;
j : Integer;
MyColour : TColor;
HSeries : array of THorizBarSeries; {added here to clarify}
begin
{attempt to add a data set to the bar chart}
SetLength(HSeries, 0);
Chart1.RemoveAllSeries;
Chart1.LeftAxis.Items.Clear;
series1.StackGroup := 0;
Chart1.LeftAxis.Items.Clear;
Chart1.LeftAxis.Items.Count := 0;
Chart1.Pages.MaxPointsPerPage := 16;
SetLength(HSeries, 150);
for i := 0 to 150 do
begin
HSeries[i] := THorizBarSeries.Create(Chart1);
Hseries[i].MultiBar := mbNone;
// case RG1.ItemIndex of
// 0 : Hseries[i].MultiBar := mbNone;
// 1 : Hseries[i].MultiBar := mbStacked100;
// end;
HSeries[i].StackGroup := i;
HSeries[i].Marks.Visible := False;
HSeries[i].BarWidthPercent := 90;
MyColour := clGreen;
Rnd := Random(45);
Rnd := 45 + Rnd;
HSeries[i].AddX(Rnd, '', MyColour);
Hseries[i].MultiBar := mbSelfStack; {prepare for multi-stack}
Chart1.LeftAxis.Items.Add(i);
Chart1.LeftAxis.Items.Item[i].Text:= IntToStr(151-i)+' GT:'+IntToStr(Rnd);
{draw the yellow and red}
for j := 2 to 3 do
begin
if j = 2 then myColour := clYellow
else MyColour := clRed;
HSeries[i].AddX(j*2, '', MyColour);
end;
Chart1.AddSeries(HSeries[i]);
end; {for i}
end;
{________________________________________________________________________}
I have tried many ways to use mbStacked100 so that the image is shown as 100%, but none successfully.
The above code produces this:
Horizontal Stacked bars
I could not find any usable sample code including on the Steema web site and documentation.
Thanks for any assistance.

Remove controls from a scrollbox

I am dynamicaly (at run time) adding controls into a TScrollBox using myScrollBox.AddObject
Now I need to remove all the controls I added to put new ones.
I tryed myScrollBox.Controls.Clear but after I call that function, any control I add are not showing up.
(Warning: I'm new to delphi and Firemonkey)
Update 1
Here is how I add my objects (this is just a test function)
procedure TMainForm.TaskDetailsAdd;
var
btn1 : TButton;
intI : Integer;
count: Integer;
begin
scbTaskVariables.BeginUpdate;
count := 0;
for intI := 0 to 100 do
begin
btn1 := TButton.Create(self);
btn1.Text := 'Salut ' + IntToStr(intI);
btn1.Parent := scbTaskVariables;
btn1.OnClick := Button1Click;
btn1.Tag := intI * 10;
btn1.Position.Y := intI * 50;
btn1.Position.X := intI * 15;
scbTaskVariables.AddObject(btn1);
count := scbTaskVariables.ControlsCount;
end;
scbTaskVariables.EndUpdate;
end;
The funny thing is that if I place a break point on count := scbTaskVariables.ControlsCount
I can see that ControlsCount goes from 0 to 1 for the first control and then it stays to 1 for the others.
Update 2
I submitted QC#125440.
The inverse of AddObject is RemoveObject. Call ScrollBox.RemoveObject(aChildObject) for each child object that you wish to remove.
The alternative is to set the Parent property of the child object. Set it to ScrollBox to add it. Set it to nil to remove it. This is interchangeable with AddObject and RemoveObject. You can do it either way.
However, when you attempt to do this, just as your said, attempts to add new controls fail if you have removed controls earlier. This would appear to be a bug. Please submit a QC report.
I tested on XE6.
Try with:
myScrollBox.Content.DeleteChildren;
I have added this as an Answer but as there are bugs in FMX it should be considered as a workaround at this stage.
I spent some time on your problem about deleting your buttons, but also to tried to find out more about the bug. David was very quick to spot this and shows his experience.
Two of my findings were that (1) the AddObect() does not appear to work with the buttons, for some reason, they are not being seen as "Objects" but as "Components". (2) Also I found that creating btn1 with the "scrollBox" as its owner helped to achieve an adequate result.
I used 1 x TScrollbox, 2 x TButton and 4 x TLabel. The buttons left with their default name and the TScrollBox with Your default name. So you can just copy and paste. btn1 is made a private variable along with it's procedures.
procedure TMainForm.TaskDetailsAdd;
var
intI : Integer;
begin
label1.Text := IntToStr(scbTaskVariables.ComponentCount);
// Initial count = 1, Probably the scroll box.
if scbTaskVariables.ComponentCount >1 then
TaskDetailsDel; // Don't create Buttons with same Name if already exists.
scbTaskVariables.BeginUpdate;
for intI := 0 to 99 do
begin
Sleep(20); //Keeps the "Pressed Button" active to prove it is working
btn1 := TButton.Create(scbTaskVariables);
btn1.Parent := scbTaskVariables;
btn1.Position.Y := intI * 50;
btn1.Position.X := intI * 15;
btn1.Tag := intI * 10;
btn1.TabOrder := 10 + intI;
btn1.Name := 'MyBtn' + IntToStr(intI);
btn1.Text := 'Salut ' + IntToStr(intI);
btn1.OnClick := Button1Click;
if btn1.IsChild(scbTaskVariables) = true then
Label2.Text := 'True'
else // All this, proves buttons not seen as children.
Label2.Text := 'False';
scbTaskVariables.AddObject(btn1);
// AddObject() taken out as button is not seen as "FmxObject"
end;
scbTaskVariables.EndUpdate;
Label3.Text := IntToStr(scbTaskVariables.ComponentCount);
// Count now all created (includes ScrollBox).
Label4.Text := IntToStr(scbTaskVariables.ControlsCount);
end;
The "TaskDetailsDel" procedure was was quite easy once I had determined that I was really dealing with "Components"
procedure TMainForm.TaskDetailsDel;
var
intI : Integer;
count: Integer;
begin
label1.Text := '';
label2.Text := '';
label3.Text := '';
label4.Text := '';
for intI := 0 to 99 do
begin
Sleep(20); //Keeps the "Pressed Button" active to prove it is working
btn1 := TButton(scbTaskVariables.FindComponent('MyBtn' + IntToStr(intI)));
btn1.Parent := Nil;
FreeAndNil(btn1);
end;
Count := scbTaskVariables.ComponentCount;
Label1.Text := IntToStr(Count);
end;
Using the FindComponent line did the trick.
Press F1 and type the links into the URL Box; I found these interesting, especially seeing how TButton is derived in the VCL and FMX.
ms-help://embarcadero.rs_xe3/libraries/Vcl.StdCtrls.TButton.html
ms-help://embarcadero.rs_xe3/libraries/FMX.Controls.TButton.html
ms-help://embarcadero.rs_xe3/libraries/FMX.Types.TStyledControl.html
ms-help://embarcadero.rs_xe3/rad/Objects,_Components,_and_Controls.html
ms-help://embarcadero.rs_xe3/libraries/FMX.Types.TFmxObject.AddObject.html
The TScrollBox has by default 1 component that is of type TScrollContent that is responsible of the display of the other components. So if we delete him then nothing will be shown ever.
I created this little function to RemoveAllComponents inside the TScrollBox (Expect the TScrollContent):
procedure RemoveAllComponentsScrollBox(ScrollBox : TScrollBox);
var i : integer; Obj : TFmxObject;
begin
for I := ScrollBox.ComponentCount-1 downto 0 do
begin
if ((ScrollBox.Components[i] is TFmxObject) and not (ScrollBox.Components[i] is TScrollContent)) then
begin
Obj:=TFmxObject(ScrollBox.Components[i]);
Obj.Parent:=nil;
FreeAndNil(Obj);
end;
end;
end;
This method can be improved by recursivity

ListView Column Resize in Delphi XE4

I face a issue with dynamically resizing the column width of a TJVListview in Delphi XE4 (in Windows 7 environment). Application takes longer time for column resize and sometimes throws access violation if there are huge data on the listview. We are using the below code for resizing the columns.
for i := 0 to LV.Columns.Count -1 do
begin
if LV.Columns.Items[i].Tag = 0 then
begin
LV.Columns.Items[i].Width := ColumnTextWidth;
LV.Columns.Items[i].Width := ColumnHeaderWidth;
end;
end;
Previously the same code used to work fine with Delphi 2009. The problem I noticed only when we are using customdrawitem event(Where we are placing images inside the listview). For the normal listview with only text display the above code is working fine.
I tried using the Column AutoSize property by setting it true, but it is of no use.
Any suggestion on how to overcome this issue. Actually, we are using the TJVlistview component in number of places in our application.
Regards,
Siran.
cODE :
1) In my form I have a JVListview, Button and imagelist. Button for loading into List view.
2) in Advancecustomdrawitem, I try to place a BMP control and also perform alternative row color change...
procedure TForm1.Button1Click(Sender: TObject);
var
i, ii: Integer;
ListItem: TListItem;
strVal : String;
begin
strVal := 'Test String';
try
ListView.Items.BeginUpdate;
LockWindowUpdate(listview.handle);
try
ListView.Clear;
for i := 1 to 15 do
begin
ListItem := ListView.Items.Add;
ListItem.SubItems.Add(strVal +'_' +IntToStr(i));
ListItem.SubItems.Add(strVal +'_' +IntToStr(i));
ListItem.SubItems.Add(strVal +'_' +IntToStr(i));
ListItem.SubItems.Add(strVal +'_' +IntToStr(i));
ListItem.SubItems.Add(strVal +'_' +IntToStr(i));
end;
finally
// for resizing the columns based on the text size
FitToTextWidth(ListView);
ListView.Items.EndUpdate;
LockWindowUpdate(0);
end;
except
on E: Exception do
MessageDlg(PWideChar(E.Message), TMsgDlgType.mtError, [TMsgDlgBtn.mbOK], 0);
end;
end;
procedure TForm1.FitToTextWidth(LV: TListView);
var
i : integer;
begin
// Set the Column width based on based on textwidth and headerwidth
for i := 0 to LV.Columns.Count -1 do
begin
if LV.Columns.Items[i].Tag = 0 then
begin
LV.Columns.Items[i].Width := ColumnTextWidth;
LV.Columns.Items[i].Width := ColumnHeaderWidth;
end;
end;
end;
procedure TForm1.LISTVIEWAdvancedCustomDrawItem(Sender: TCustomListView;
Item: TListItem; State: TCustomDrawState; Stage: TCustomDrawStage;
var DefaultDraw: Boolean);
Var
R : TRect;
C : TCanvas;
B : TBitMap;
begin
// Set C
C := (Sender as TListView).Canvas;
// Set R
R := Item.DisplayRect(drLabel);
B := TBitMap.Create;
B.Transparent := True;
B.TransparentColor := clWhite;
// based on item index set the image and change the row color
if odd(item.Index) = true then
begin
ImageList.GetBitmap(0,B);
TJvListItem( Item ).Brush.Color := clWhite;
TJvListItem( Item ).Font.Color := clBlack;
end
else
begin
ImageList.GetBitmap(1,B);
TJvListItem( Item ).Brush.Color := clMoneyGreen;
TJvListItem( Item ).Font.Color := clBlack;
end;
C.Draw(R.Left + 5 ,R.Top, B);
B.Free;
end;
The above code works well with Delphi 2009... but currently trying migrating to XE4 in Win 7 environment.. my problem here is, it takes lot of time in loading the list view (When performing column resizing dynamically by calling FitToTextWidth method) .. but without this method it is working fine but without column resizing...
When you set the width of a column to any one of the automatic constants, the control have to evaluate the length of the items/subitems to be able to calculate the necessary width. This takes time.
Also, when you set the width of a column, the VCL ListView updates all columns.
You have six columns, setting the width of any one of them involves 6 column updates, together with the spurious call in your FitToTextWidth procedure, your code is causing reading all items/subitems of a column 42 times (due to the code path in VCL: 1 time for 1st col, 2 times for 2nd -> 21 times for setting the width of 6 columns). Enclose your width setting in Begin/EndUpdate calls and remove the extra call, and you'll finish it in 6 rounds.
procedure TForm1.FitToTextWidth(LV: TListView);
var
i : integer;
begin
// Set the Column width based on based on textwidth and headerwidth
LV.Columns.BeginUpdate;
try
for i := 0 to LV.Columns.Count -1 do
begin
if LV.Columns.Items[i].Tag = 0 then
begin
// LV.Columns.Items[i].Width := ColumnTextWidth;
LV.Columns.Items[i].Width := ColumnHeaderWidth;
end;
end;
finally
LV.Columns.EndUpdate;
end;
end;
As I don't get any AV with your test case, I cannot comment on that.

Dynamically created buttons with equal alignment

I am a newbie to this Delphi. I have been given an assignment that to create buttons dynamically. But the problem is that all buttons have to be aligned in a manner that it should fit inside the whole screen. i.e, if 10 buttons created the whole screen should be filled. Or if 9 is given 9 should be present and filled in the screen. Is it possible to do that? I tried and searched everywhere. But was helpless.
Please help me if its possible. A good example is also appreciated since I mentioned earlier I am really new to this. The code I did follows here.
procedure TfrmMovieList.PnlMovieClick(Sender: TObject);
begin
for i := 0 to 9 do
begin
B := TButton.Create(Self);
B.Caption := Format('Button %d', [i]);
B.Parent := Panel1;
B.Height := 23;
B.Width := 100;
B.Left := 10;
B.Top := 10 + i * 25;
end;
end;
This looks workable to me:
procedure TForm1.CreateButtons(aButtonsCount, aColCount: Integer; aDestParent: TWinControl);
var
rowCount, row, col, itemWidth, itemHeight: Integer;
item: TButton;
begin
if aColCount>aButtonsCount then
aColCount := aButtonsCount;
rowCount := Ceil(aButtonsCount / aColCount);
itemHeight := aDestParent.Height div rowCount;
itemWidth := aDestParent.Width div aColCount;
for row := 0 to rowCount-1 do begin
for col := 0 to aColCount-1 do begin
item := TButton.Create(Self);
item.Caption := Format('Button %d', [(row*aColCount)+col+1]);
item.Left := itemWidth*col;
item.Top := itemHeight*row;
item.Width := itemWidth;
item.Height := itemHeight;
item.Parent := aDestParent;
Dec(aButtonsCount);
if aButtonsCount=0 then
Break;
end; // for cols
end; // for rows
end;
An example of usage is:
procedure TForm1.Button1Click(Sender: TObject);
begin
CreateButtons(10, 4, Panel1);
end;
The function Ceil requires the uses of unit Math.
The method receives the count of buttons and the numbers of columns to calculate the number of rows. It also receives the destination parent where the buttons will be located.

Resources