Solved

Add an Event on same component for all forms

Posted on 2012-03-18
20
526 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 37

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
Windows Server 2016: All you need to know

Learn about Hyper-V features that increase functionality and usability of Microsoft Windows Server 2016. Also, throughout this eBook, you’ll find some basic PowerShell examples that will help you leverage the scripts in your environments!

 

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 37

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 37

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 37

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 37

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 37

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 37

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 37

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 37

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

ScreenConnect 6.0 Free Trial

Discover new time-saving features in one game-changing release, ScreenConnect 6.0, based on partner feedback. New features include a redesigned UI, app configurations and chat acknowledgement to improve customer engagement!

Question has a verified solution.

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

Suggested Solutions

Introduction I have seen many questions in this Delphi topic area where queries in threads are needed or suggested. I know bumped into a similar need. This article will address some of the concepts when dealing with a multithreaded delphi database…
In my programming career I have only very rarely run into situations where operator overloading would be of any use in my work.  Normally those situations involved math with either overly large numbers (hundreds of thousands of digits or accuracy re…
Two types of users will appreciate AOMEI Backupper Pro: 1 - Those with PCIe drives (and haven't found cloning software that works on them). 2 - Those who want a fast clone of their boot drive (no re-boots needed) and it can clone your drive wh…
The Email Laundry PDF encryption service allows companies to send confidential encrypted  emails to anybody. The PDF document can also contain attachments that are embedded in the encrypted PDF. The password is randomly generated by The Email Laundr…

770 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