?
Solved

Add an Event on same component for all forms

Posted on 2012-03-18
20
Medium Priority
?
543 Views
Last Modified: 2012-03-19
Hello,

   I have a database Application using Absolute Database. I have around 140 forms, all of them uses the TABSTable.

   I want to add three events for TABSTable on all 140 forms, when events occurs, I want to execute same code for all Tables.

 Events I want to trigger are :

OnDeleteError
OnEditError
OnPostError

and the procedures looks like:

procedure TForm.TablePostError(DataSet: TDataSet; E: EDatabaseError; var Action: TDataAction);

procedure TForm.TableEditError(DataSet: TDataSet; E: EDatabaseError; var Action: TDataAction);

procedure TForm.TableDeleteError(DataSet: TDataSet; E: EDatabaseError; var Action: TDataAction);


  Three events should execute the same code for all tables in all forms, it is hard to go to every form and add the three events to every Table.

any solution?

Thanks in Advance!
0
Comment
Question by:Ahmad_Egypt
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 10
  • 9
20 Comments
 
LVL 4

Expert Comment

by:MichaelStaszewski
ID: 37734822
You should subclass tabstable. It should have DoDeleteError, DoPostError, and DoEditError defined in the base class. Look at the source of tabstable and confirm that they are there and marked as virtual or override. In your subclass you would override those methods and put the code in that you are using in the event handlers. Don't forget to call inherited in those methods, typically as the first line.

You'll need to register your new component and search/replace your pas and dfm files for tabstable and change those declarations to create your new component. It's not that much work over assigning them all to a common handler and it's the more correct approach. If you need a fully working sample I can provide one tomorrow when I have my computer up.
0
 

Author Comment

by:Ahmad_Egypt
ID: 37735188
yes please
0
 
LVL 38

Expert Comment

by:Geert Gruwez
ID: 37736598
looks like you need form inheritance

you can also descend a form from a form you create yourself
for example:
if you want pages, a logo, and a statusbar on each form
first make a form with those on
> next add new, form, inherited from the one you created

if you want events in the design editor available, you'll to use RegisterCustomModule

Here are some links of how to do that:
http://www.youtube.com/watch?v=2R9ODPa6794
http://www.webtechcorp.com/web-developer-training-delphi-article-vfi-1.htm
http://delphi.about.com/od/oopindelphi/a/delphi_oop4.htm
http://etutorials.org/Programming/mastering+delphi+7/Part+II+Delphi+Object-Oriented+Architectures/Chapter+8+The+Architecture+of+Delphi+Applications/Visual+Form+Inheritance/
0
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 

Author Comment

by:Ahmad_Egypt
ID: 37736735
Geert_Gruwez VFI is not what I am looking for

I just want to trap three messages on same component on all forms.

my 140 form are totally different from each other.
0
 
LVL 38

Expert Comment

by:Geert Gruwez
ID: 37736927
ow sorry, missed the same component on every form

i don't use Absolute, but this is the idea for subclassing:
(you'll need the protected definitions of the Absolute unit for this)
my guess is the TablePostError is called by a dynamic DoTablePostError procedure

guessed Absolute unit code:
type
  TAbsTable = class(TAbsDataset)
  protected
    procedure DoTablePostError(Dataset: TDataset; E: EDatabaseError; var Action: TDataAction);
  end;

Open in new window


subclassing (uses the same name as the class subclassed from):
unit AbsoSubs;

type
  TAbsTable  = class(Absolute.TAbsTable)
    procedure DoTablePostError(Dataset: TDataset; E: EDatabaseError; var Action: TDataAction);[b] override;[/b]
  end;

procedure TAbsTable.DoTablePostError(Dataset: TDataset; E: EDatabaseError; var Action: TDataAction); 
begin
  // Add your code here to run before the OnTablePostError Event
  inherited DoTablePostError(Dataset, E, Action); 
  // Add your code here to run after the OnTablePostError Event
end;

Open in new window


place the AbsoSubs unit as last in the interface uses clause.

fyi the code for the DoTablePostError would be something like this:
procedure TAbsTable.DoTablePostError(DataSet: TDataSet; E: EDatabaseError; var Action: TDataAction);
begin
  if Assigned(fOnTablePostError) then 
    fOnTablePostError(Dataset, E, Action);
end;

Open in new window


since you don't want to manually assign the events the dynamic routines would be a better option
and if still want tot override your new default behaviour you could change it:

keep in mind, i'm guessing at the code in the Absolute unit
(i'm also guessing about the Absolute unit name ... )
procedure TAbsTable.DoTablePostError(Dataset: TDataset; E: EDatabaseError; var Action: TDataAction); 
begin
  if not Assigned(OnTablePostError) then 
  begin  
    // Add your code here to run before the OnTablePostError Event
  end else 
    inherited DoTablePostError(Dataset, E, Action); 
  if not Assigned(OnTablePostError) then 
  begin  
    // Add your code here to run after the OnTablePostError Event
  end;
end;

Open in new window


your code is only executed if no event is assigned
0
 

Author Comment

by:Ahmad_Egypt
ID: 37737144
and what if I don't have the source code of Absolute database!!!!

bad luck :(
0
 
LVL 38

Expert Comment

by:Geert Gruwez
ID: 37737183
lol, ok, i was actually looking for it
google can be a good friend in such cases, i found some old sources
let you know in a minute on how to proceed
0
 
LVL 38

Expert Comment

by:Geert Gruwez
ID: 37737263
these are all error procedures you want

this may be a problem.
I ran through all the code (google absmain.pas should give you some sources)
up to TDataset.

All error handling is done by calling CheckOperation procedure
This routine is private to TDataset
So we can't override this (> this would have been the easy way)

Next> we'll have to walk back up the ladder to find where we can override the error resolving

>> I'll get back to you
0
 
LVL 38

Expert Comment

by:Geert Gruwez
ID: 37737307
do you have a sample of what you want to do ?
or the idea ... in a bit more detail than in your Q header ?
0
 

Author Comment

by:Ahmad_Egypt
ID: 37737462
ok here check code below:

procedure TForm1.Table1DeleteError(DataSet: TDataSet; E: EDatabaseError; var Action: TDataAction);
begin
   Action:=daAbort;
   if (E is EABSEngineError) then
   begin
      case (EABSEngineError(E).ErrorCode) of

          ABS_ERR_RECORD_LOCKED:
          begin
            if MessageDlg('Record Could not be deleted, Retry ? ', mtWarning,[mbYes,mbNo],0) = mrYes then
                        Action:=daRetry;
          end;

          ABS_ERR_TABLE_LOCKED:
          begin
            if MessageDlg('Record Could not be deleted, Retry ?', mtWarning,[mbYes,mbNo],0)=mrYes then
                Action:=daRetry;
          end;

          ABS_ERR_DELETE_RECORD_MODIFIED:
          begin
             DataSet.Refresh;
             Action := daRetry;
          end;

          ABS_ERR_DELETE_RECORD_DELETED:
          begin
             MessageDlg('Record Already deleted.', mtWarning,[mbOk],0);
             DataSet.Refresh;
          end
          else
             MessageDlg(E.Message,mtError,[mbOK],0);
      end
   end
   else
   begin
     MessageDlg(E.Message,mtError,[mbOK],0);
   end;
end;

procedure TForm1.Table1EditError(DataSet: TDataSet; E: EDatabaseError; var Action: TDataAction);
begin
   Action:=daAbort;
   if (E is EABSEngineError) then
   begin
      case (EABSEngineError(E).ErrorCode) of

        ABS_ERR_RECORD_LOCKED:
        begin
           if MessageDlg('Could not Update Record Now, Retry ?', mtWarning,[mbYes,mbNo],0)=mrYes then
              Action:=daRetry;
        end;

        ABS_ERR_TABLE_LOCKED:
        begin
           if MessageDlg('Could not Update Record Now, Retry ?', mtWarning,[mbYes,mbNo],0)=mrYes then
              Action:=daRetry;
        end;

        ABS_ERR_UPDATE_RECORD_MODIFIED:
        begin
           DataSet.Refresh;
           Action:=daRetry;
        end;

        ABS_ERR_UPDATE_RECORD_DELETED:
        begin
           MessageDlg('Sorry, Record you are trying to Update, is Deleted.',mtWarning,[mbOk],0);
           DataSet.Refresh;
           Action:=daRetry;
        end
        else
          MessageDlg(E.Message,mtError,[mbOK],0);
      end;
   end
   else
   begin
      MessageDlg(E.Message,mtError,[mbOK],0);
   end;
end;

procedure TForm1.Table1PostError(DataSet: TDataSet; E: EDatabaseError; var Action: TDataAction);
begin
   Action:=daAbort;
   if (E is EABSEngineError) then
   begin
      if (EABSEngineError(E).ErrorCode = ABS_ERR_CONSTRAINT_VIOLATED) then
      begin
         MessageDlg(EABSEngineError(E).ErrorMessage+ 'Could not updare Record, Please try again later',mtError,[mbOK],0);
      end
      else
      begin
         if (EABSEngineError(E).ErrorCode = ABS_ERR_TABLE_LOCKED) then
         begin
           if MessageDlg('Could not Update Record, Retry ?', mtWarning,[mbYes,mbNo],0)=mrYes then
            Action:=daRetry;
         end
         else
         begin
           MessageDlg(E.Message,mtError,[mbOK],0);
         end;
      end;
   end
   else
   begin
      MessageDlg(E.Message,mtError,[mbOK],0);
   end;
end;

Open in new window

0
 

Author Comment

by:Ahmad_Egypt
ID: 37737563
I have an Idea, I don't know if I can implement it in my code and do the requested task...

which is to put an ApplicationEvents Component on the main form, and handle it's (OnException) event, like code below:

procedure TForm1.ApplicationEvents1Exception(Sender: TObject; E: Exception);
begin
     if E is EABSException then
     begin
        // do something here , ask if it is a Delete,Post or Edit Erorr !!!
     end;
end;

Open in new window


it is an Idea, maybe true and maybe not!
0
 
LVL 38

Accepted Solution

by:
Geert Gruwez earned 2000 total points
ID: 37737575
hmm i ended with a unit using a constructor with default edit, post and delete handlers

add this unit as last in interface uses clasus
unit uAbsSubs;

interface

uses DB, ABSMain, Classes;

type
  TAbsTable = class(AbsMain.TABSTable)
  protected
    procedure DefaultDeleteError(DataSet: TDataSet; E: EDatabaseError; var Action: TDataAction);
    procedure DefaultEditError(DataSet: TDataSet; E: EDatabaseError; var Action: TDataAction);
    procedure DefaultPostError(DataSet: TDataSet; E: EDatabaseError; var Action: TDataAction);
  public
    constructor Create(aOwner: TComponent); override;
  end;

implementation

uses Dialogs, ABSConst, Controls;

constructor TAbsTable.Create(aOwner: TComponent);
begin
  inherited Create(aOwner);
  OnDeleteError := DefaultDeleteError;
  OnEditError := DefaultEditError;
  OnPostError := DefaultPostError;
end;

procedure TAbsTable.DefaultDeleteError(DataSet: TDataSet; E: EDatabaseError; var Action: TDataAction);
begin
  Action:=daAbort;
  if E is EABSEngineError then
    case (EABSEngineError(E).ErrorCode) of
      ABS_ERR_RECORD_LOCKED, ABS_ERR_TABLE_LOCKED:
        if MessageDlg('Record Could not be deleted, Retry ? ', mtWarning, [mbYes, mbNo],0) = mrYes then
          Action := daRetry;
      ABS_ERR_DELETE_RECORD_MODIFIED:
        begin
          DataSet.Refresh;
          Action := daRetry;
        end;
      ABS_ERR_DELETE_RECORD_DELETED:
        begin
          MessageDlg('Record Already deleted.', mtWarning, [mbOk], 0);
          DataSet.Refresh;
        end
      else
        MessageDlg(E.Message, mtError, [mbOK], 0);
    end
  else
    MessageDlg(E.Message, mtError, [mbOK], 0);
end;

procedure TAbsTable.DefaultEditError(DataSet: TDataSet; E: EDatabaseError; var Action: TDataAction);
begin
  Action:=daAbort;
  if E is EABSEngineError then
    case EABSEngineError(E).ErrorCode of
      ABS_ERR_RECORD_LOCKED, ABS_ERR_TABLE_LOCKED:
        if MessageDlg('Could not Update Record Now, Retry ?', mtWarning, [mbYes, mbNo],0) = mrYes then
          Action := daRetry;
      ABS_ERR_UPDATE_RECORD_MODIFIED:
        begin
           DataSet.Refresh;
           Action:=daRetry;
        end;
      ABS_ERR_UPDATE_RECORD_DELETED:
        begin
          MessageDlg('Sorry, Record you are trying to Update, is Deleted.',mtWarning,[mbOk],0);
          DataSet.Refresh;
          Action:=daRetry;
        end
      else
        MessageDlg(E.Message,mtError,[mbOK],0);
    end
  else
    MessageDlg(E.Message,mtError,[mbOK],0);
end;

procedure TAbsTable.DefaultPostError(DataSet: TDataSet; E: EDatabaseError; var Action: TDataAction);
begin
  Action := daAbort;
  if E is EABSEngineError then
  begin
    if EABSEngineError(E).ErrorCode = ABS_ERR_CONSTRAINT_VIOLATED then
      MessageDlg(EABSEngineError(E).ErrorMessage+ 'Could not updare Record, Please try again later', mtError, [mbOK], 0)
    else
    begin
      if EABSEngineError(E).ErrorCode = ABS_ERR_TABLE_LOCKED then
      begin
        if MessageDlg('Could not Update Record, Retry ?', mtWarning, [mbYes, mbNo],0) = mrYes then
          Action := daRetry
        else
          MessageDlg(E.Message,mtError,[mbOK],0);
      end;
    end;
  end
    else
    MessageDlg(E.Message,mtError,[mbOK],0);
end;

end.

Open in new window

0
 

Author Comment

by:Ahmad_Egypt
ID: 37737590
I will try now.

 Just save the unit and add it as last in interface uses clause ? no additional code ?
0
 
LVL 38

Expert Comment

by:Geert Gruwez
ID: 37737597
no, that's the trick

uses clause like this works:
uses Classes, Controls, ... AbsMain ..., uAbsSubs;

disabling the subclassing for TAbsTable:
uses Classes, Controls, uAbsSubs, ... AbsMain;

you asked to easily change 140 forms...
response, adding 1 unit to the uses interface clause as last unit
remember : this is for every TAbsTable on the form
0
 

Author Comment

by:Ahmad_Egypt
ID: 37737618
aha so adding the clause on all 140 forms not only the main form ?
0
 

Author Comment

by:Ahmad_Egypt
ID: 37737624
did you see my suggestion about ApplicationEvents ?
0
 
LVL 38

Expert Comment

by:Geert Gruwez
ID: 37737634
yes, that's a solution, but you can't get the fine grained action
> you can't set the retry, abort, etc
0
 

Author Comment

by:Ahmad_Egypt
ID: 37737668
WORKED! Thanks!

if you have an experience with Indy, Kindly check this question

http://www.experts-exchange.com/Programming/Languages/Pascal/Delphi/Q_27629648.html
0
 
LVL 38

Expert Comment

by:Geert Gruwez
ID: 37737705
i have checked that Q.
I briefly tried TCPClient and TCPServer but had the same problems.
Sending large text or files is rather cumbersome

i use FTP to send files ...
0
 

Author Comment

by:Ahmad_Egypt
ID: 37737727
it may be a better solution , Thanks :)
0

Featured Post

Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article explains how to create forms/units independent of other forms/units object names in a delphi project. Have you ever created a form for user input in a Delphi project and then had the need to have that same form in a other Delphi proj…
In this tutorial I will show you how to use the Windows Speech API in Delphi. I will only cover basic functions such as text to speech and controlling the speed of the speech. SAPI Installation First you need to install the SAPI type library, th…
In this video, Percona Solutions Engineer Barrett Chambers discusses some of the basic syntax differences between MySQL and MongoDB. To learn more check out our webinar on MongoDB administration for MySQL DBA: https://www.percona.com/resources/we…
Are you ready to place your question in front of subject-matter experts for more timely responses? With the release of Priority Question, Premium Members, Team Accounts and Qualified Experts can now identify the emergent level of their issue, signal…
Suggested Courses

650 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question