FreeReport: how to format If-Then - delphi

I use FreeReport (from FastReport) and I need to implement such code:
If TOTALPAGES > 1 then Pageheader.visible = false
I do not know, where to write this code, I tried to put inside a pascal code, it not works.
And this record do not works also:
[IFF([TOTALPAGES] > 1,'PAGEHEADER.VIBLE=0')]
What is the right way to do this?

The postition to usually place code would be a the OnBeforePrint (*) event of then PageHeader band, but this won't work with <TotalPages#>
procedure PageHeader1OnBeforePrint(Sender: TfrxComponent);
begin
TfrxPageHeader(Sender).visible := (<TotalPages#> = 1);
end;
The problem with this approach is <TotalPages#> won't be evaluated at this time.
A second problem here is the showing or hiding the PageHeader might affect the count of the pages. To achieve the desired result you will have to render the report by frxreport1.PrepareReport(true);. You might do this twice, with visible PageHeader and unvisble PageHeader. Every part of a report can be accesses by frxReport1.FindObject. Make sure this is assigned before using it.
As a sidenote, another place to effect the objects on printing/preview is the OnPrint event of the frxReport component, which will be called for every object before it's rendered.
begin
frxReport1.FindObject('PageHeader1').Visible := true;
frxReport1.PrepareReport(true);
// in my test case 2 Pages
Showmessage(IntToStr(frxReport1.PreviewPages.Count));
frxReport1.ShowPreparedReport;
frxReport1.FindObject('PageHeader1').Visible := false;
frxReport1.PrepareReport(true);
// in my test case 1 Page
Showmessage(IntToStr(frxReport1.PreviewPages.Count));
frxReport1.ShowPreparedReport;
end;
The usual place implement report code:

You can try similar code inside report:
[if([PAGE#] < [TOTALPAGES], 'Ok', 'Not Ok')]

Related

Odd behaviour when adding a toolbutton to the delphi ide

I was trying out some things and wanted to make a delphi IDE extension.
My basic idea was expanding the ToDo list feature that is currently in the IDE.
Step one was adding a toolbutton to the IDE which would open a form showing the todo items.
But I noticed some weird things that I hopefully caused myself since that would mean it can be easily fixed.
I am adding my toolbutton to the CustomToolbar, which is the one with the blue questionmark (see screenshot later)
The thing that happens: I install my package and the button is added with the correct image, right next to the existing button.
Now I close the modal form with the installed packages and then the blue questionmark changes.
Don't mind the icon I used, I will use a different one eventually but ok.
So basicly the existing item changes to my own icon but disabled for some reason. And I can't figure out why this happens.
As suggested in the guide I found online I used a TDatamodule to implement my code.
My code:
procedure TDatamoduleToDoList.Initialize;
var
LResource, LhInst: Cardinal;
begin
LhInst := FindClassHInstance(Self.ClassType);
if LhInst > 0 then
begin
LResource := FindResource(LhInst, 'icon', RT_Bitmap);
if LResource > 0 then
begin
FBMP := Vcl.Graphics.TBitmap.Create;
FBMP.LoadFromResourceName(LhInst, 'icon');
end
else
DoRaise('Resource not found');
end
else
DoRaise('HInstance Couldn''t be found');
FToDoAction := TTodoAction.Create(Self);
FToDoAction.Category := actionCat;
FToDoAction.ImageIndex := FIntaServices.ImageList.Add(FBMP, nil);
FToDoAction.Name := 'my_very_own_action_man';
end;
procedure TDatamoduleToDoList.DataModuleCreate(Sender: TObject);
begin
//Create extension
if Supports(BorlandIDEServices, INTAServices, FIntaServices) then
begin
Initialize;
if FToDoAction <> nil then
FCustBut := TSpeedButton(FIntaServices.AddToolButton(sCustomToolBar, 'CstmToDoList', FToDoAction))
else
DoRaise('Initialize failed');
end
else
DoRaise('Something went wrong');
end;
DoRaise is my own procedure that simply destroys all of my objects and raises an exception, did this to prevent mem leaks in the ide.
But, I think, I don't do anything weird but yet this problem occurs.
So I'm hoping someone here might have done something simular and sees the error in my code.
Thanks in advance.
P.s. if you need any more info or see the rest of the unit let me know and ill put the entire unit on github or something like that.
Edit:
Thanks to #Uwe Raabe I managed to solve this problem.
The problem was found in the comments of INTAServices.AddImages
AddImages takes all the images from the given image list and adds them
to the
main application imagelist. It also creates an internal mapping array from the
original image indices to the new indices in the main imagelist. This
mapping is used by AddActionMenu to remap the ImageIndex property of the
action object to the new ImageIndex. This should be the first method
called when adding actions and menu items to the main application window.
The return value is the first index in the main application image list of
the first image in the source list. Call this function with an nil
image list to clear the internal mapping array. Unlike the AddImages function from
the ancestor interface, this version takes an Ident that allows the same base index
to be re-used. This is useful when the IDE implements demand-loading of
personalities so that the images will only get registered once and the same image
indices can be used.
The solution eventually was adding my image to a local imagelist which was added to the imagelist of IntaServices
Code:
procedure TDatamoduleToDoList.DataModuleCreate(Sender: TObject);
begin
//Create extension
if Supports(BorlandIDEServices, INTAServices, FIntaServices) then
begin
Initialize;
if FToDoAction <> nil then
begin
FCustBut := TSpeedButton(FIntaServices.AddToolButton(sCustomToolBar, 'CstmToDoList', FToDoAction));
FToDoAction.ImageIndex := FIntaServices.AddImages(FImages);//This is the fix
end
else
DoRaise('Initialize failed');
end
else
DoRaise('Something went wrong');
end;
You are not supposed to fiddle around with the INTAServices.ImageList directly. Instead use either INTAServices.AddMasked or INTAServices.AddImages (in case you have a local imagelist in your datamodule).
You can safely use the INTAServices.ImageList to be connected to your controls, but you should neither Add nor Delete the images in it directly.

Shortcut triggers TAction on first created form instead of form with focus

I found (in Delphi 2010) that shortcuts always end up on first form (as owned by main form) that has that action, but not the currently focused form. My TMainFrm owns several TViewFrm. Each has a TActionManager with the same TActons.
I see some ways out, but wonder whats the best fix.. (and not a bad hack)
The forms are navigated using a tabset which calls their Hide() and Show(). I'd did not expect hidden forms to receive keypresses. Am i doing something wrong?
It seems that action shortcuts are always start at the main form, and using TCustomForm.IsShortCut() get distributed to owned forms. I see no logic there to respect hidden windows, should i override it and have it trigger the focused form first?
Disabling all TActions in TViewFrm.Hide() .. ?
Moving the TActionToolBar to TMainFrm but that is a pit of snakes and last resort.
I have found a workaround thats good enough for me; my main form now overrides TCustomForm.IsShortcut() and first checks visible windows from my list of editor tabs.
A list which i conveniently already have, so this might not work for everyone.
// Override TCustomForm and make it check the currently focused tab/window first.
function TFormMain.IsShortCut(var Message: TWMKey): Boolean;
function DispatchShortCut(const Owner: TComponent) : Boolean; // copied function unchanged
var
I: Integer;
Component: TComponent;
begin
Result := False;
{ Dispatch to all children }
for I := 0 to Owner.ComponentCount - 1 do
begin
Component := Owner.Components[I];
if Component is TCustomActionList then
begin
if TCustomActionList(Component).IsShortCut(Message) then
begin
Result := True;
Exit;
end
end
else
begin
Result := DispatchShortCut(Component);
if Result then
Break;
end
end;
end;
var
form : TForm;
begin
Result := False;
// Check my menu
Result := Result or (Menu <> nil) and (Menu.WindowHandle <> 0) and
Menu.IsShortCut(Message);
// Check currently focused form <------------------- (the fix)
for form in FEditorTabs do
if form.Visible then
begin
Result := DispatchShortCut(form);
if Result then Break;
end;
// ^ wont work using GetActiveWindow() because it always returns Self.
// Check all owned components/forms (the normal behaviour)
if not Result then
Result := inherited IsShortCut(Message);
end;
Another solution would be to change DispatchShortCut() to check for components being visible and/or enabled, but that might impact more than i'd like. I wonder whether the original code architects had a reason not to -- by design. Best would be have it called twice: first to give priority to visible+enabled components, and second call as fallback to normal behavior.

Delphi. How to Disable/Enable controls without triggering controls events

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.

Delphi: is it possibile in the OnFormShow event to tell a form not to display even for a millisecond?

In the OnFormShow event I need (for a particular set of conditions) not to show the form.
Something like "if counter > 15 don't show the form".
I could of course refactor and move many things on form create, but this is a lot of work, because this is a common form and there are too many changes involved.
Now I close the form at the end of OnFormShow but anyway I see the form appear for some milliseconds.
Unfortunately the condition that tells me not to show the form is decided inside OnFormShow. Is there a trick to avoid the form to show?
Refactor your code so that it doesn't show at all until you are ready. Either refrain from calling Show, or set Visible to False if you have not yet done so.
I suspect it's too late by the time you reach OnShow but even so doing it that way would be indicative of poor design. Moving code out of OnShow into a different method really should not be very much trouble at all.
+1 on the refactoring, but in the mean time, try this:
AlphaBlend := true;
AlphaBlendValue := 0;
That should make the form invisible, and seemed to work in my OnShow test app (D2010/XP). I'm guessing you'll need to add code to make the form close, possibly a timer?
A very bad solution is to do
procedure TForm1.FormShow(Sender: TObject);
begin
inc(n);
if n > 15 then
begin
Left := Screen.DesktopWidth + 32;
Top := Screen.DesktopHeight + 32;
PostMessage(Handle, WM_CLOSE, 0, 0);
end;
end;

Stack Overflow in Delphi

I am posting my Stack Overflow problem on StackOverflow.com. Irony at its best!
Anyways. I am calling this procedure on my SkypeReply event handler, which gets fired a lot:
Procedure OnCategoryRename;
Var
CategoryID : Integer;
sCtgName : String;
Begin
if (AnsiContainsStr(pCommand.Reply,'GROUP')) and (AnsiContainsStr(pCommand.Reply,'DISPLAYNAME')) then
begin
sCtgName := pCommand.Reply;
Delete(sCtgName,1,Pos('GROUP',sCtgName)+5);
CategoryID := StrToInt(Trim(LeftStr(sCtgName,Pos(' ',sCtgName))));
sCtgName := GetCategoryByID(CategoryID).DisplayName; // Removing THIS line does not produce a Stack Overflow!
ShowMessage(sCtgName);
end;
The idea of this is to loop thru my list of Skype Groups, to see what group has been renamed. AFAIK thats of no importance, as my S.O has been traced to appear here
Function GetCategoryByID(ID : Integer):IGroup;
Var
I : Integer;
Category : IGroup;
Begin
// Make the default result nil
Result := nil;
// Loop thru the CUSTOM CATEGORIES of the ONLY SKYPE CONTROL used in this project
// (which 100% positive IS attached ;) )
for I := 1 to frmMain.Skype.CustomGroups.Count do
Begin
// The Category Variable
Category := frmMain.Skype.CustomGroups.Item[I];
// If the current category ID returned by the loop matches the passed ID
if Category.Id = ID then
begin
// Return the Category as Result (IGroup)
Result := Category;
// Exit the function.
Exit;
end;
End;
End;
When I set a breakpoint at Result := Category; and Single Step thru, those 2 lines get executed over and over, right after each other!
And when I comment out the sCtgName := GetCategoryByID(CategoryID).DisplayName; in the first code snippet, there is no Overflow, the message gets shown that one time it is supposed to. However, the GetCategoryByID is a function I wrote, and I wrote one similar, too, which works just fine (GetCategoryByName), so I don't get why it decided to repeat the
// Return the Category as Result (IGroup)
Result := Category;
// Exit the function.
Exit;
over and over again.
EDIT: Here is how you can reproduce it: https://gist.github.com/813389
EDIT: Here is my CallStack, as requested:
Edit2: More info:
Make sure to compile your project with "optimization" off, "stack frames" on and "use debug .dcu" on to get the most detailed callstack possible. Then post the callstack you get when you hit the stack overflow here (if you have trouble identifying the nature of the problem from it).
What doesn't show up in your question :
the "OnCategoryRename" function you posted up here is a subfunction called from a "TForm.Skype1Reply" callback.
To see this, I had to click on your github link - yet I think it is an important point of your problem.
My guess :
Your "GetCategoryById" function actually sends a query, which triggers "Skype1Reply".
If the groupname has changed, "Skype1Reply" calls "OnCategoryRename".
"OnCategoryRename" calls "GetCategoryById"
"GetCategoryById" triggers "Skype1Reply"
Somehow, the test saying "if groupname has changed" is still true, so "Skype1Reply" calls "OnCategoryRename"
"OnCategoryRename" calls "GetCategoryById"
rinse, repeat
I think a quick and dirty fix would be to change
sCtgName := GetCategoryByID(CategoryID).DisplayName; // Removing THIS line does not produce a Stack Overflow!
with
sCtgName := //find another way to get the new name, which you can probably get from your ICommand object
pCommand.Reply.ReadDataFromReplyAndGetNewDisplayName;
In the future, I suggest you post your complete code sample for this kind of question.
Stack overflows could be caused by endless recursion.
You have to be very careful when you write code that has event handlers in it.
One thing you can do to help you debug this is, as David says, step INTO rather than over such calls. F7 steps into a call.
Another thing you can do is put a breakpoint at the top of the function GetCategoryById. Now look at your Call Stack. Do you see the repeated name in the stack? This should make it very clear.

Resources