Solved

Add an Event on same component for all forms

Posted on 2012-03-18
20
520 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
  • 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 36

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
 

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 36

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 36

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 36

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 36

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
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 

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 36

Accepted Solution

by:
Geert Gruwez earned 500 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 36

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 36

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 36

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

How to improve team productivity

Quip adds documents, spreadsheets, and tasklists to your Slack experience
- Elevate ideas to Quip docs
- Share Quip docs in Slack
- Get notified of changes to your docs
- Available on iOS/Android/Desktop/Web
- Online/Offline

Join & Write a Comment

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…
Introduction Raise your hands if you were as upset with FireMonkey as I was when I discovered that there was no TListview.  I use TListView in almost all of my applications I've written, and I was not going to compromise by resorting to TStringGrid…
This video shows how to remove a single email address from the Outlook 2010 Auto Suggestion memory. NOTE: For Outlook 2016 and 2013 perform the exact same steps. Open a new email: Click the New email button in Outlook. Start typing the address: …
This video demonstrates how to create an example email signature rule for a department in a company using CodeTwo Exchange Rules. The signature will be inserted beneath users' latest emails in conversations and will be displayed in users' Sent Items…

760 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

Need Help in Real-Time?

Connect with top rated Experts

21 Experts available now in Live!

Get 1:1 Help Now