Jump to content
Johnny Smash

Footman

Recommended Posts

Een professional inhuren voor een privé project is niet te doen. Ik zal dus Delphi zelf moeten leren. Laten we eenvoudig beginnen:

 

program footman;

uses
  Forms,
  fmmain in 'fmmain.pas' {frmMain},
  fmseason in 'fmseason.pas' {FormSeasons},
  fmpropcompetition in 'fmpropcompetition.pas' {FormPropCompetition},
  fmabout in 'fmabout.pas' {FormAbout},
  fmpropstadium in 'fmpropstadium.pas' {FormPropStadium},
  fmpropplayer in 'fmpropplayer.pas' {FormPropPlayer},
  fmpropcountry in 'fmpropcountry.pas' {FormPropCountry},
  fmpropreferee in 'fmpropreferee.pas' {FormPropReferee},
  fmpropteam in 'fmpropteam.pas' {FormPropTeam},
  fmpropround in 'fmpropround.pas' {frmPropRound},
  fmpageteam in 'fmpageteam.pas' {FormPageBaseTeam},
  fmpageplayer in 'fmpageplayer.pas' {FormPageBasePlayer},
  fmpagereferee in 'fmpagereferee.pas' {FormPageBaseReferee},
  fmpagestadium in 'fmpagestadium.pas' {FormPageBaseStadium},
  fmpagecountry in 'fmpagecountry.pas' {FormPageBaseCountry},
  fmdmbasic in 'fmdmbasic.pas' {BasicData: TDataModule},
  fmpageposition in 'fmpageposition.pas' {FormPageBasePosition},
  fmpagesystem in 'fmpagesystem.pas' {FormPageBaseSystem},
  fmpagecoach in 'fmpagecoach.pas' {FormPageBaseCoach},
  fmpropcoach in 'fmpropcoach.pas' {FormPropCoach},
  fmnewstadiumname in 'fmnewstadiumname.pas' {FormRenameStadium},
  fmconsts in 'fmconsts.pas',
  fmseasonteam in 'fmseasonteam.pas' {frmSeasonTeam},
  fmseasonplayer in 'fmseasonplayer.pas' {frmSeasonPlayer},
  fmseasoncoach in 'fmseasoncoach.pas' {frmSeasonCoach},
  fmseasonreferee in 'fmseasonreferee.pas' {frmSeasonReferee},
  fmseasonstadium in 'fmseasonstadium.pas' {frmSeasonStadium},
  fRenameTeam in 'fRenameTeam.pas' {frmRenameTeam},
  fmround in 'fmround.pas' {frmRounds},
  fmmatch in 'fmmatch.pas' {frmMatch},
  fmseasonview in 'fmseasonview.pas' {frmSeasonView},
  fmdmprop in 'fmdmprop.pas' {dtmProp: TDataModule},
  fmoptions in 'fmoptions.pas' {frmOptions},
  fmdbprop in 'fmdbprop.pas' {frmDBProperties},
  fdbinfothread in 'fdbinfothread.pas',
  fmatchview in 'fmatchview.pas' {frmMatchView},
  dstat in 'dstat.pas' {dtmStat: TDataModule},
  sqlconst in 'sqlconst.pas',
  fmatchedit in 'fmatchedit.pas' {frmMatchEdit},
  fSeasonViewDraft in 'fSeasonViewDraft.pas' {frmSeasonViewDraft},
  dSeason in 'dSeason.pas' {dtmSeason: TDataModule},
  dMatch in 'dMatch.pas' {dtmMatch: TDataModule},
  fNewPlayerNr in 'fNewPlayerNr.pas' {frmNewPlayerNr},
  fmbasicdata in 'fmbasicdata.pas' {FormBasicData},
  fdoDatabase in 'fdoDatabase.pas' {doDatabase: TDataModule},
  fNewSeasonProperties in 'fNewSeasonProperties.pas' {frmNewSeasonProperties},
  fDebugLog in 'fDebugLog.pas' {frmDebugLog},
  fBaseDataObject in 'fBaseDataObject.pas' {doBaseDataObject},
  fBaseDataObjectInteger in 'fBaseDataObjectInteger.pas' {doBaseDataObjectInteger: TDataModule},
  fDoSeason in 'fDoSeason.pas' {doSeason: TDataModule},
  fSeasonRound in 'fSeasonRound.pas' {frmSeasonRound},
  fDoMatch in 'fDoMatch.pas' {doMatch: TDataModule},
  dMatchNew in 'dMatchNew.pas' {dtmMatchNew: TDataModule},
  fmatch in 'fmatch.pas' {frmMatchNew};

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TfrmMain, frmMain);
  Application.CreateForm(TdoDatabase, doDatabase);
  Application.CreateForm(TdtmProp, dtmProp);
  Application.CreateForm(TdtmStat, dtmStat);
  Application.CreateForm(TdtmSeason, dtmSeason);
  Application.CreateForm(TBasicData, BasicData);
  Application.CreateForm(TdtmMatch, dtmMatch);
  Application.CreateForm(TfrmDebugLog, frmDebugLog);
  Application.Run;
end.

 

Kan iemand mij in gewoon nederlands kort uitleggen wat hier gebeurt, a.u.b.?

 

Share this post


Link to post
Guest

Ahhhhhhhhhhhhh!!!! help help b:classic_blink:

 

 

 

Al uw formulieren worden automatisch aangemaakt doordat de "Auto-Create" -optie is ingeschakeld in uw projectconfiguratie. Alles wordt dus gemaakt en moet worden vernietigd wanneer uw aanvraag onder normale omstandigheden is voltooid. De regel "RUN" is waar uw hoofdformulier zal worden uitgevoerd, waarbij uw toepassing wordt gestart in de gebruikersweergave. het is helemaal geen wenselijke praktijk. Het zou ideaal zijn om de formulieren te maken, gezien de noodzaak voor het gebruik ervan. niet alleen om geheugen te besparen, wat in veel gevallen niet veel uitmaakt of zoveel impact heeft, maar ook om goede praktijken en projectorganisatie te bevorderen.

Share this post


Link to post

Duidelijk. Het zou dus beter zijn om de formulieren later te creëeren. Op het moment dat ze werkelijk nodig zijn. Laten we verder gaan met fmmain:

 

unit fmmain;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
  Menus, ComCtrls, ToolWin, StdCtrls, ImgList, StdActns, ActnList, RzPanel, 
  Buttons, ExtCtrls, RzStatus, fdoDatabase;

const
  MINFORMHEIGHT   = 300;
  MINFORMWIDTH    = 400;
  NORMALFORMHEIGHT= 475;
  NORMALFORMWIDTH = 635;

type
  TfrmMain = class(TForm)
    MainMenu           : TMainMenu;
    MnuFile            : TMenuItem;
    MnuNew             : TMenuItem;
    MnuOpen            : TMenuItem;
    MnuClose           : TMenuItem;
    N1                 : TMenuItem;
    MnuExit            : TMenuItem;
    MnuDatabase        : TMenuItem;
    OpenDialog         : TOpenDialog;
    ToolBar1           : TToolBar;
    ToolButton1        : TToolButton;
    ToolButton2        : TToolButton;
    ToolButton3        : TToolButton;
    ToolButton4        : TToolButton;
    ImageList1         : TImageList;
    ImageList2         : TImageList;
    btnDatabase        : TToolButton;
    PMDatabase         : TPopupMenu;
    PMSeasons          : TMenuItem;
    PMBasicData        : TMenuItem;
    mniBasic           : TMenuItem;
    mniReopen          : TMenuItem;
    mniSaveAs          : TMenuItem;
    mniAllSeasons      : TMenuItem;
    mniActiveSeason    : TMenuItem;
    mniSeasons         : TMenuItem;
    mniHelp            : TMenuItem;
    mniAbout           : TMenuItem;
    N2                 : TMenuItem;
    mniContents        : TMenuItem;
    mniTools           : TMenuItem;
    mniOptions         : TMenuItem;
    N3                 : TMenuItem;
    mniDBProperties    : TMenuItem;
    ImageList3         : TImageList;
    aclMenu            : TActionList;
    actEditCopy        : TEditCopy;
    actEditCut         : TEditCut;
    actEditPaste       : TEditPaste;
    imlMenu            : TImageList;
    mniEdit            : TMenuItem;
    actUndo            : TAction;
    actRepeat          : TAction;
    Cut1               : TMenuItem;
    Copy1              : TMenuItem;
    Paste1             : TMenuItem;
    Undo1              : TMenuItem;
    Repeat1            : TMenuItem;
    actNewDatabase     : TAction;
    actOpenDatabase    : TAction;
    actReopenDatabase  : TAction;
    actSaveDatabase    : TAction;
    actCloseDatabase   : TAction;
    StatusBar          : TRzStatusBar;
    stsSeasonName      : TRzStatusPane;
    stsDetails         : TRzStatusPane;
    RzKeyStatus1       : TRzKeyStatus;
    RzKeyStatus2       : TRzKeyStatus;
    RzKeyStatus3       : TRzKeyStatus;
    RzClockStatus1     : TRzClockStatus;
    actViewToolBarEdit : TAction;
    mniView            : TMenuItem;
    ShowEdittoolbar1   : TMenuItem;
    mniWindow          : TMenuItem;
    Debuglog1          : TMenuItem;
    procedure MnuOpenClick(Sender: TObject);
    procedure MnuExitClick(Sender: TObject);
    procedure DisplayHint(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure MnuNewClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure MnuCloseClick(Sender: TObject);
    procedure mniBasicClick(Sender: TObject);
    procedure mniActiveSeasonClick(Sender: TObject);
    procedure mruDBSelectFile(Sender: TObject; FileName: String);
    procedure mniOptionsClick(Sender: TObject);
    procedure mniDBPropertiesClick(Sender: TObject);
    procedure actNewDatabaseHint(var HintStr: String;
      var CanShow: Boolean);
    procedure Debuglog1Click(Sender: TObject);
    procedure mniAllSeasonsClick(Sender: TObject);
  private
    FdoDatabase : TdoDatabase;

    FDateFormat : string;
    // active season information
    FActiveCompetitionIdx : Integer;
    FActiveSeasonIdx      : Integer;
    FActiveSeasonName     : string;
    // active database information
    FDatabaseActive : boolean; // is database active
    FDatabasePath : string; // stored path to data
    FDatabaseName : string; // name of main database file
    FTableNamePrefix : string; // table name prefix
    procedure OpenDatabase(DBName: string);
  public
    SeasonOpen : boolean;
    function FormExist(FormName: string): boolean;
    procedure UpdateWindowList;
    procedure DebugLog(aLine: string);
    constructor Create(aOwner: TComponent); override;
  published
    // the database object
    property doDatabase : TdoDatabase read FdoDatabase;
    property DateFormat : string      read FDateFormat write FDateFormat;
    // active season information
    property ActiveCompetition : integer read FActiveCompetitionIdx write FActiveCompetitionIdx;
    property ActiveSeason      : integer read FActiveSeasonIdx      write FActiveSeasonIdx;
    property ActiveSeasonName  : string  read FActiveSeasonName     write FActiveSeasonName;
    // active database information
    property DatabaseActive  : boolean read FDatabaseActive  write FDatabaseActive;
    property DatabasePath    : string  read FDatabasePath    write FDatabasePath;
    property DatabaseName    : string  read FDatabaseName    write FDatabaseName;
    property TableNamePrefix : string  read FTableNamePrefix write FTableNamePrefix;
  end;

var
  frmMain : TfrmMain;

implementation

uses
  fmseason, fmabout, fmdmbasic, 
  fmbasicdata, fmseasonview, fmdmprop, fmoptions, fmdbprop, fmmatch, dstat, 
  fmconsts, fDebugLog;

{$R *.DFM}

//__________________________________________________________________________________________
constructor TfrmMain.Create(aOwner: TComponent);
begin
  inherited Create(aOwner);
  // create the database object
  FdoDatabase := TdoDatabase.Create(Self);
end;

//__________________________________________________________________________________________
procedure TfrmMain.MnuOpenClick(Sender: TObject);
begin
  if MDIChildCount > 0 then
    MessageDlg('Please close all windows first', mtInformation, [mbOk], 0)
  else
    begin
      if frmMain.DatabaseActive then
        if MessageDlg('Do you want to close the current database?',
                      mtConfirmation, mbYesNoCancel, 0) <> mrYes then
          Exit;
      if OpenDialog.Execute then
        OpenDatabase(OpenDialog.FileName);
    end;
end; // MnuOpenClick

//__________________________________________________________________________________________
procedure TfrmMain.OpenDatabase(DBName: string);
begin
  if (BasicData.OpenDatabase(DBName) < ERROR_NO_ERROR) then
    MessageDlg('An error occured opening the database', mtError, [mbOk], 0)
  else
    begin
      //    mruDB.AddFile(DBName);
      btnDatabase.Enabled     := true;
      //mnuCompetitions.Enabled := true;
      mniBasic.Enabled        := true;
      PMSeasons.Enabled       := true;
      PMBasicData.Enabled     := true;
      mnuClose.Enabled        := true;
      mniAllSeasons.Enabled   := true;
      mniActiveSeason.Enabled := true;
      mniDBProperties.Enabled := true;
    end;
end;

//__________________________________________________________________________________________
procedure TfrmMain.MnuExitClick(Sender: TObject);
begin
  Close;
end; // MnuExitClick

//__________________________________________________________________________________________
procedure TfrmMain.DisplayHint(Sender: TObject);
begin
  if Application.Hint <> '' then
    stsSeasonName.Caption := Application.Hint
  else
    stsSeasonName.Caption := ActiveSeasonName;
end; // DisplayHint

//__________________________________________________________________________________________
procedure TfrmMain.FormCreate(Sender: TObject);
begin
  Application.OnHint := DisplayHint;
  ActiveSeason       := -1;
  ActiveSeasonName   := '';
  ActiveCompetition  := -1;
  Height             := NORMALFORMHEIGHT;
  Width              := NORMALFORMWIDTH;
  FDateFormat        := ShortDateFormat; //'dd-mm-yyyy';
  //ShortDateFormat:='dd-mm-yyyy'; //FDateFormat;
  //UpdateFormatSettings:=False;
  SeasonOpen := false;
  dtmStat    := nil;
end; // FormCreate

//__________________________________________________________________________________________
procedure TfrmMain.MnuNewClick(Sender: TObject);
begin
  //ShowMessage(Data.Database.Params[0]);
end; // MnuNewClick

//__________________________________________________________________________________________
procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  //dtmProp.CloseQueries;
  //dtmStat.CloseQueries;
  //BasicData.CloseDatabase;
end; // FormClose

//__________________________________________________________________________________________
procedure TfrmMain.MnuCloseClick(Sender: TObject);
begin
  Basicdata.CloseDatabase;
  btnDatabase.Enabled     := false;
  //mnuCompetitions.Enabled := false;
  mniBasic.Enabled        := false;
  PMSeasons.Enabled       := false;
  PMBasicData.Enabled     := false;
  mnuClose.Enabled        := false;
  mniAllSeasons.Enabled   := false;
  mniActiveSeason.Enabled := false;
  mniDBProperties.Enabled := false;
end; // MnuCloseClick

//__________________________________________________________________________________________
procedure TfrmMain.mniBasicClick(Sender: TObject);
begin
  if MDIChildCount > 0 then
    MessageDlg('Please close other windows first', mtInformation, [mbOk], 0)
  else
    begin
      try
        Screen.Cursor := crHourGlass;
        Application.CreateForm(TFormBasicData, FormBasicData);
        MniBasic.Checked    := True;
        PMBasicData.Checked := True;
        FormBasicData.Show;
      finally
        Screen.Cursor := crDefault;
      end;
    end;
end; // mniBasicClick

//__________________________________________________________________________________________
procedure TfrmMain.mniActiveSeasonClick(Sender: TObject);
begin
  if ActiveSeason<0 then
    begin
      MessageDlg('No season selected', mtInformation, [mbOk], 0);
      Exit;
    end;
  if not SeasonOpen then
    begin
      try
        Screen.Cursor := crHourGlass;
        Application.CreateForm(TfrmSeasonView, frmSeasonView);
        frmSeasonView.InitializeForm;
        //frmSeasonView.ResetForm(Self);
        SeasonOpen := true;
      finally
        Screen.Cursor := crDefault;
      end;
    end;
  frmSeasonView.Show;
end; // mniActiveSeasonClick

//__________________________________________________________________________________________
function TfrmMain.FormExist(FormName: string): boolean;
var
  i         : integer;
  FoundForm : boolean;
begin
  FoundForm := false;
  i         := 0;
  while (not FoundForm) and (i < MDIChildCount) do
    begin
      if (UpperCase(MDIChildren[i].Name) = UpperCase(FormName)) then
        FoundForm := true;
      Inc(i);
    end;
  Result := FoundForm;
end; // FormExist

//__________________________________________________________________________________________
procedure TfrmMain.mruDBSelectFile(Sender: TObject; FileName: String);
begin
  OpenDatabase(FileName);
end; // mruDBSelectFile

//__________________________________________________________________________________________
procedure TfrmMain.mniOptionsClick(Sender: TObject);
begin
  Application.CreateForm(TfrmOptions, frmOptions);
  frmOptions.ShowModal;
end; // mniOptionsClick

//__________________________________________________________________________________________
procedure TfrmMain.mniDBPropertiesClick(Sender: TObject);
begin
  try
    Cursor := crHourGlass;
    if not FormExist('frmDBProperties') then
      Application.CreateForm(TfrmDBProperties, frmDBProperties);
  finally
    Cursor := crDefault;
  end;
  frmDBProperties.Show;
end; // mniDBPropertiesClick

//__________________________________________________________________________________________
procedure TfrmMain.actNewDatabaseHint(var HintStr: String;
  var CanShow: Boolean);
begin
  HintStr := 'Create a new database';
  CanShow := true;
end; // actNewDatabaseHint

//__________________________________________________________________________________________
procedure TfrmMain.UpdateWindowList;
begin
  // maak de lijst leeg
  {mniWindow.Clear;
  for ChildNr := 0 to MDIChildCount - 1 do
  begin
  end;}
end; // UpdateWindowList

//__________________________________________________________________________________________
procedure TfrmMain.DebugLog(aLine: string);
begin
  // write line to debug log
  frmDebugLog.WriteToDebugLog(aLine);
  Application.ProcessMessages;
end;

//__________________________________________________________________________________________
procedure TfrmMain.Debuglog1Click(Sender: TObject);
begin
  if USE_DEBUG_LOG then
    begin
      frmDebugLog.Show;
      Left := frmDebuglog.width + 5;
      SetFocus;
    end;
end;

procedure TfrmMain.mniAllSeasonsClick(Sender: TObject);
begin
  if MDIChildCount > 0 then
    MessageDlg('Please close all windows first', mtInformation, [mbOk], 0)
  else
    begin
     // if not MnuCompetitions.Checked then
        begin
          LockWindowUpdate(Handle);
          Application.CreateForm(TFormSeasons, FormSeasons);
          LockWindowUpdate(0);
          //MnuCompetitions.Checked := True;
          PMSeasons.Checked       := True;
          FormSeasons.Top         := FormSeasons.Top div 2;
        end;
      FormSeasons.Show;
    end;
end;

end.

Misschien teveel code tegelijk. Maar ik zou graag van elke procedure iets willen begrijpen. Het formulier ziet er zo uit:

 

praxis.JPG

Share this post


Link to post

Please try to use the English language. And please post longer code-segments as file-attachments.

Share this post


Link to post
Guest
8 hours ago, Johnny Smash said:

...
Eigenschappen en variabelen maken die niet standaard in het project zijn, dat wil zeggen, ze hebben een specifieke toepassing in dit project. 
Het programma probeert zijn patroon te creëren van het creëren of faciliteren van sommige acties in deze applicatie ... 
maar ik zie dat veel van hen misschien niet nodig zijn! Meer is slechts een mening!

  public
    SeasonOpen : boolean;
    function FormExist(FormName: string): boolean;
    procedure UpdateWindowList;
    procedure DebugLog(aLine: string);
    constructor Create(aOwner: TComponent); override;
  published
    // the database object
    property doDatabase : TdoDatabase read FdoDatabase;
    property DateFormat : string      read FDateFormat write FDateFormat;
    // active season information
    property ActiveCompetition : integer read FActiveCompetitionIdx write FActiveCompetitionIdx;
    property ActiveSeason      : integer read FActiveSeasonIdx      write FActiveSeasonIdx;
    property ActiveSeasonName  : string  read FActiveSeasonName     write FActiveSeasonName;
    // active database information
    property DatabaseActive  : boolean read FDatabaseActive  write FDatabaseActive;
    property DatabasePath    : string  read FDatabasePath    write FDatabasePath;
    property DatabaseName    : string  read FDatabaseName    write FDatabaseName;
    property TableNamePrefix : string  read FTableNamePrefix write FTableNamePrefix;
  end;

...
implementation

// Hier zeggen we dat we toegang zullen krijgen tot formulieren en al hun componenten en andere objecten en variabelen, die zijn opgeslagen in andere eenheden (buiten deze)
uses
  fmseason, fmabout, fmdmbasic, 
  fmbasicdata, fmseasonview, fmdmprop, fmoptions, fmdbprop, fmmatch, dstat, 
  fmconsts, fDebugLog;

{$R *.DFM}

....


constructor TfrmMain.Create(aOwner: TComponent);
begin
  inherited Create(aOwner); // De standaardprocedure overschrijven, meestal wanneer u wilt dat 'iets' vaker gebeurt of wordt gedefinieerd ... een bepaald gebruik voor het project!
  // create the database object
  FdoDatabase := TdoDatabase.Create(Self); // <--- het maken van een database-object! onnodig, dus Object Pascal heeft het! Maar als u van plan bent een eigen code te gebruiken,
                                           //  zoals die van een bepaald bedrijf, enz ...
end;

//__________________________________________________________________________________________
procedure TfrmMain.MnuOpenClick(Sender: TObject);
begin
  if MDIChildCount > 0 then // Controleren of er subvensters zijn in het huidige formulier (in dit geval het hoofdvenster) ... als die er zijn, sluit ze dan allemaal!
    MessageDlg('Please close all windows first', mtInformation, [mbOk], 0)
  else
    begin
      if frmMain.DatabaseActive then // Als de database open is, sluit u deze! Als de database open is, sluit u deze en verlaat u deze procedure (de onderstaande regels worden niet uitgevoerd)
        if MessageDlg('Do you want to close the current database?',
                      mtConfirmation, mbYesNoCancel, 0) <> mrYes then
          Exit;  // "Exit", verlaat de onderstaande regels niet en verlaat de procedure!
      if OpenDialog.Execute then // Als u niet op "YES" drukt, voer dan de dialoog uit om een gewenst bestand te openen .... !!!!
        OpenDatabase(OpenDialog.FileName);
    end;
end; // MnuOpenClick

//__________________________________________________________________________________________
procedure TfrmMain.OpenDatabase(DBName: string);
begin
  if (BasicData.OpenDatabase(DBName) < ERROR_NO_ERROR) then
    MessageDlg('An error occured opening the database', mtError, [mbOk], 0)
  else // De database is met succes geopend, dus schakel deze componenten in ...
    begin
      //    mruDB.AddFile(DBName);
      btnDatabase.Enabled     := true;
      //mnuCompetitions.Enabled := true;
      mniBasic.Enabled        := true;
      PMSeasons.Enabled       := true;
      PMBasicData.Enabled     := true;
      mnuClose.Enabled        := true;
      mniAllSeasons.Enabled   := true;
      mniActiveSeason.Enabled := true;
      mniDBProperties.Enabled := true;
    end;
end;

//__________________________________________________________________________________________
procedure TfrmMain.MnuExitClick(Sender: TObject);
begin
  Close;  // "Sluiten" in het formulier betekent, sluiten, in dit geval is het formulier het hoofdformulier, en vervolgens de applicatie sluiten!
end; // MnuExitClick

//__________________________________________________________________________________________
procedure TfrmMain.DisplayHint(Sender: TObject);
begin
  if Application.Hint <> '' then  // Controleert of er een vooraf gedefinieerde tip is (tijdens het ontwerp van het project) of gebruikt de waarde van "ActivaSeasonName" als een tip
    stsSeasonName.Caption := Application.Hint
  else
    stsSeasonName.Caption := ActiveSeasonName;
end; // DisplayHint

//__________________________________________________________________________________________
procedure TfrmMain.FormCreate(Sender: TObject); //Hier definieert u de beginwaarden voor de variabelen wanneer het hoofdformulier wordt gemaakt
begin
  Application.OnHint := DisplayHint;
  ActiveSeason       := -1;
  ActiveSeasonName   := '';
  ActiveCompetition  := -1;
  Height             := NORMALFORMHEIGHT;
  Width              := NORMALFORMWIDTH;
  FDateFormat        := ShortDateFormat; //'dd-mm-yyyy';
  //ShortDateFormat:='dd-mm-yyyy'; //FDateFormat;
  //UpdateFormatSettings:=False;
  SeasonOpen := false;
  dtmStat    := nil;
end; // FormCreate

//__________________________________________________________________________________________
procedure TfrmMain.MnuNewClick(Sender: TObject);
begin
  //ShowMessage(Data.Database.Params[0]); // Toont een bericht aan de gebruiker, in dit geval de waarde van de eerste parameter die is gedefinieerd in de databasecomponent
end; // MnuNewClick

//__________________________________________________________________________________________
procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);  //
begin
  //dtmProp.CloseQueries;  // Sluit bij het sluiten van de applicatie alle tabellen en de database
  //dtmStat.CloseQueries;
  //BasicData.CloseDatabase;
end; // FormClose

//__________________________________________________________________________________________
procedure TfrmMain.MnuCloseClick(Sender: TObject);  // Hier sluiten we de database en schakelen we waarschijnlijk alle componenten uit om te voorkomen dat ze om welke reden dan ook worden gebruikt.
begin
  Basicdata.CloseDatabase;
  btnDatabase.Enabled     := false;
  //mnuCompetitions.Enabled := false;
  mniBasic.Enabled        := false;
  PMSeasons.Enabled       := false;
  PMBasicData.Enabled     := false;
  mnuClose.Enabled        := false;
  mniAllSeasons.Enabled   := false;
  mniActiveSeason.Enabled := false;
  mniDBProperties.Enabled := false;
end; // MnuCloseClick

//__________________________________________________________________________________________
procedure TfrmMain.mniBasicClick(Sender: TObject); // Controleer of er al een formulier is gemaakt, zo niet, maak dan een nieuw formulier aan, activeer enkele opties en toon het gemaakte formulier
begin
  if MDIChildCount > 0 then
    MessageDlg('Please close other windows first', mtInformation, [mbOk], 0)
  else
    begin
      try
        Screen.Cursor := crHourGlass;  // Het cursorpictogram wijzigen in alleen schermeffect ... niets bijzonders!
        Application.CreateForm(TFormBasicData, FormBasicData);
        MniBasic.Checked    := True;
        PMBasicData.Checked := True;
        FormBasicData.Show;
      finally
        Screen.Cursor := crDefault;
      end;
    end;
end; // mniBasicClick

//__________________________________________________________________________________________
procedure TfrmMain.mniActiveSeasonClick(Sender: TObject); 
// Controleren of er een "Sessie" is (gerelateerd aan de Database - deze is open, in gebruik, enz ...) als dat het geval is, verlaat dan deze procedure.
// Zo niet, maak dan een formulier aan en toon het ... zoals in de bovenstaande procedure
begin
  if ActiveSeason<0 then
    begin
      MessageDlg('No season selected', mtInformation, [mbOk], 0);
      Exit;
    end;
  if not SeasonOpen then
    begin
      try
        Screen.Cursor := crHourGlass;
        Application.CreateForm(TfrmSeasonView, frmSeasonView);
        frmSeasonView.InitializeForm;
        //frmSeasonView.ResetForm(Self);
        SeasonOpen := true;
      finally
        Screen.Cursor := crDefault;
      end;
    end;
  frmSeasonView.Show;
end; // mniActiveSeasonClick

//__________________________________________________________________________________________
function TfrmMain.FormExist(FormName: string): boolean;
var
  i         : integer;
  FoundForm : boolean;
begin
//Hier doorlopen we alle formulieren die in het geheugen zijn gemaakt en als er een wordt gevonden die we willen, dan is dit de waarde die door deze functie wordt geretourneerd 
// ... waarschijnlijk zal deze worden gebruikt door een andere procedure die deze functie heeft genoemd.
  FoundForm := false;
  i         := 0;
  while (not FoundForm) and (i < MDIChildCount) do
    begin
      if (UpperCase(MDIChildren[i].Name) = UpperCase(FormName)) then
        FoundForm := true;
      Inc(i);
    end;
  Result := FoundForm;
end; // FormExist

//__________________________________________________________________________________________
procedure TfrmMain.mruDBSelectFile(Sender: TObject; FileName: String);
begin
  OpenDatabase(FileName); // Het gewenste databasebestand openen
end; // mruDBSelectFile

//__________________________________________________________________________________________
procedure TfrmMain.mniOptionsClick(Sender: TObject);
begin
  Application.CreateForm(TfrmOptions, frmOptions); // Een formulier aanmaken en op het scherm tonen
  frmOptions.ShowModal;
end; // mniOptionsClick

//__________________________________________________________________________________________
procedure TfrmMain.mniDBPropertiesClick(Sender: TObject);
begin
  try
    Cursor := crHourGlass;
    if not FormExist('frmDBProperties') then // Als het formulier niet bestaat, maak het dan aan en toon het op het scherm ...
      Application.CreateForm(TfrmDBProperties, frmDBProperties);
  finally
    Cursor := crDefault;
  end;
  frmDBProperties.Show;
end; // mniDBPropertiesClick

//__________________________________________________________________________________________
procedure TfrmMain.actNewDatabaseHint(var HintStr: String;
  var CanShow: Boolean);
begin
  HintStr := 'Create a new database';  // Gewoon een tip definiëren en zeggen dat deze op een bepaald moment tijdens het gebruik kan worden weergegeven
  CanShow := true;
end; // actNewDatabaseHint

//__________________________________________________________________________________________
procedure TfrmMain.UpdateWindowList;
begin
  // maak de lijst leeg
  {mniWindow.Clear;  // Een snelle manier om formulieren schoon te maken (in sommige gevallen te vernietigen)
  for ChildNr := 0 to MDIChildCount - 1 do
  begin
  end;}
end; // UpdateWindowList

//__________________________________________________________________________________________
procedure TfrmMain.DebugLog(aLine: string);
begin
  //Een handleiding "Debug" maken ... gewoon wat tekst schrijven in een component of bestand ...
  // De "ProcessMessage" probeert de stroom van de applicatie voort te zetten zonder vast te lopen in deze procedure, dus het schrijven is gedaan ... 
  //een soort van iets doen en doorgaan met wat ik aan het doen was zonder dat de gebruiker het merkt
  // write line to debug log
  frmDebugLog.WriteToDebugLog(aLine);
  Application.ProcessMessages;
end;

//__________________________________________________________________________________________
procedure TfrmMain.Debuglog1Click(Sender: TObject);
begin
  // Als de "handmatige foutopsporing" is gedefinieerd en in gebruik is, laat het me dan zien ... en concentreer je erop
  if USE_DEBUG_LOG then
    begin
      frmDebugLog.Show;
      Left := frmDebuglog.width + 5;
      SetFocus;
    end;
end;

procedure TfrmMain.mniAllSeasonsClick(Sender: TObject);
begin
  // Hetzelfde als hierboven, waar wordt gecontroleerd of het formulier al bestaat, en zo niet, maak het dan aan en toon het op het scherm
  // 
  if MDIChildCount > 0 then
    MessageDlg('Please close all windows first', mtInformation, [mbOk], 0)
  else
    begin
     // if not MnuCompetitions.Checked then
        begin
          LockWindowUpdate(Handle);
          Application.CreateForm(TFormSeasons, FormSeasons);
          LockWindowUpdate(0);
          //MnuCompetitions.Checked := True;
          PMSeasons.Checked       := True;
          FormSeasons.Top         := FormSeasons.Top div 2;
        end;
      FormSeasons.Show;
    end;
end;

 

Ten slotte gebruikt deze applicatie de "MDI" -techniek, die daar veel werd gebruikt in MSWindows 3 en misschien zelfs XP, als ik me niet vergis (of zeer vergis) ...
Het "MDI" -patroon is echter handig wanneer u een applicatie wilt maken waarin u een hoofdformulier (de applicatie) en meerdere vensters (subformulier) erin hebt ... in MSWindows 3 hadden we "Cardfile" wie heeft uw documenten gemaakt met behulp van deze "MDI" -techniek ... heb je het leren kennen?

 

Cardfile.png.e8b494e5686063be8a1054894f691a54.png

 

https://en.wikipedia.org/wiki/Cardfile

https://en.wikipedia.org/wiki/Multiple-document_interface

 


Tegenwoordig gebruiken we deze techniek niet meer omdat er andere zijn, maar het is prima om het te gebruiken, als je dat wilt!

 

knuffel

Edited by Guest

Share this post


Link to post
14 hours ago, Stano said:

Where is the published code from? Own? Probably not. Do you have experience with programming? If so, which ones? In any case, I very hard recommend you

http://docwiki.embarcadero.com/Libraries/Sydney/en/Main_Page

The code is from around 1998 to 2000. It is the code for the program called FOOTMAN. And it is unique. It was not written by me. But I (co)own the code.

Share this post


Link to post

In de eerste plaats bedankt voor de tijd en moeite, die je neemt om de code uit te leggen, emailx45. Lovenswaardig. (((Ik ben trouwens niet diegene van mijn foto. De foto is een eerbetoon aan die persoon zelf.))) Ik ga proberen elke dag een snippet te plaatsen. Ik hoop dat je de tijd en energie kan vinden. Ik weet niet of we het volhouden. Er zijn aardig wat forms te bespreken. Je bent natuurlijk niet verplicht. We zien wel. Ik sla fmseason even over voor dit moment. Laten we verder gaan met het eenvoudige fmabout:

 

unit fmabout;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, StdCtrls, Buttons;

type
  TFormAbout = class(TForm)
    BBtnOk: TBitBtn;
    PhysMem: TLabel;
    PhysFre: TLabel;
    MemFree: TProgressBar;
    Label1: TLabel;
    Label2: TLabel;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure BBtnOkClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FormAbout: TFormAbout;

implementation

{$R *.DFM}

procedure TFormAbout.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action:=caFree;
end;

procedure TFormAbout.BBtnOkClick(Sender: TObject);
begin
  Close;
end;

end.

De code spreekt eigenlijk voor zich. Maar toch graag uitleg van de 2 genoemde procedures. Het formulier ziet er zo uit:

 

praxis.JPG

Share this post


Link to post

Use help first. Place the cursor in / on the (caFree) keyword and press F1

Close = Self.Close = FormAbout.Close = onFormClose

Edited by Stano

Share this post


Link to post

De volgende snippet:

unit fdoDatabase;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
  DBTables, DB;

type
  TdoDatabase = class(TDataModule)
    dbsFootman : TDatabase;
  private
    procedure SetDatabasePath(const Value: string);
    function GetDatabasePath: string;
    function GetActive: boolean;
    procedure SetActive(const Value: boolean);
    { Private declarations }
  public
    { Public declarations }
    constructor Create(aOwner: TComponent); override;

    property DatabasePath: string read GetDatabasePath write SetDatabasePath;
    property Active: boolean read GetActive write SetActive;
  end;

var
  doDatabase: TdoDatabase;
  
implementation

{$R *.DFM}

//__________________________________________________________________________________________
constructor TdoDatabase.Create(aOwner: TComponent);
begin
  inherited Create(aOwner);
  // disconnect the database
  dbsFootman.Close;
end;

//__________________________________________________________________________________________
function TdoDatabase.GetActive: boolean;
begin
  Result := dbsFootman.Connected;
end;

//__________________________________________________________________________________________
function TdoDatabase.GetDatabasePath: string;
begin
  Result := dbsFootman.Params.Values['path'];
end;

//__________________________________________________________________________________________
procedure TdoDatabase.SetActive(const Value: boolean);
begin
  dbsFootman.Connected := Value;
end;

//__________________________________________________________________________________________
procedure TdoDatabase.SetDatabasePath(const Value: string);
begin
  if Value <> GetDatabasePath then
    begin
      // disconnect the database
      dbsFootman.Connected := False;
      // and set the database to the new path
      dbsFootman.Params.Values['path'] := Value;
    end;
end;

end.

Wat gebeurt hier? Het formulier met de TDatabase:

 

 

praxis.JPG

Share this post


Link to post
Guest
On 1/14/2021 at 12:17 PM, Johnny Smash said:

Action:=caFree;

U gebruikt de waarde "caFree" alleen als een reactie op de component, alleen als deze (component) zichzelf kan vernietigen! Net als bij formulieren!
Alleen als het formulier is gemaakt met de volgende opdrachtregel:
xFormToCreate: = TFormAnyOne.Create (SELF);
waarom de definitie van eigendom, in dit geval "ZELF", naar zichzelf verwijst. De vorm zelf moet dus zijn "vernietiger" zijn na het vernietigen (loslaten) van alle componenten die erin zijn ondergebracht.

 

----------------------------

28 minutes ago, Johnny Smash said:

inherited Create(aOwner);

definieert dat een dergelijke gebeurtenis de definities / eigenschappen van zijn voorouder moet "erven", in dit geval de voorouderklasse van de huidige klasse "TdoDatabase".


De andere definities en gebeurtenissen hebben betrekking op openen, sluiten, het definiëren van enkele parameters voordat een actie wordt uitgevoerd, niets bijzonders.

  • property DatabasePath: string read GetDatabasePath write SetDatabasePath;
  • property Active: boolean read GetActive write SetActive;

zijn twee eigenschappen die zijn gemaakt om de toegang tot sommige eigenschappen of waarden te vergemakkelijken, niets uitzonderlijks.

Aangezien dit een overgeërfde "gegevensmodule" is, hoeft deze in feite niet eens te bestaan. Je zou de gewone RAD Studio / Delphi "Data Module" kunnen gebruiken.

Quote

dbsFootman ---> TDatabase or descendent

dbsFootman is de TDatabase-component, verantwoordelijk voor toegang tot de database, dat wil zeggen, het definiëren van welk bestand, login, wachtwoord en andere noodzakelijke parameters.
Dit onderdeel is het startpunt voor u om de tabelonderdelen (Tabel, Query, FDTable, FDQuery of andere) die u moet gebruiken, te gebruiken en de records (de gegevens uit de tabellen0) te tonen.

hug

Edited by Guest

Share this post


Link to post
Guest

hi @Johnny Smash

Geen probleem graag gedaan!
Probeer echter alleen fragmenten te posten die u echt niet begrijpt of die erg relevant zijn, om de onderwerpen niet te vervuilen.

Share this post


Link to post
Guest

Hier is een voorbeeld dat ik gebruik heel eenvoudig en gemakkelijk te begrijpen wanneer u formulieren moet maken die niet afhankelijk zijn van anderen.

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses
  uMyFormSecond; { Ik geef toegang tot objecten en andere waarden die in de eenheid staan "uMyFormSencond.pas" }

procedure TForm1.Button1Click(Sender: TObject);
var
  lMyFormX: TMyFormSecond;
  {
    Deze eenheid krijgt de tweede vorm die ik hier aanroep, met alle noodzakelijke definities ervoor.
    Hier maak ik gewoon en laat ik het op het scherm zien.
  }
begin
  lMyFormX := TMyFormSecond.Create(nil);
  try
    lMyFormX.ShowModal; { "ShowModal", toon het venster (formulier) uitsluitend op het scherm, dat wil zeggen, de focus zal zijn en niemand vóór hem! }
  finally
    {
      lMyFormX.Free;
      lMyFormX := nil;
    }
    // of gewoon
    FreeAndNil(lMyFormX);
    {
      Vernietig dit formulier en al zijn objecten nadat u heeft gedaan wat u wilt.
      In dit geval moet ik het formulier handmatig vernietigen, want toen ik het creëerde, gebruikte ik de definitie "NIL", wat betekent dat ik verantwoordelijk zal zijn voor het vernietigen van het object dat ik geloofde.
      Anders dan:
      xxxxx.CREATE (SELF) ===> het object zelf moet zijn vernietiger zijn
      xxxxx.CREATE (APPLICATION) ===> het object zelf moet worden vernietigd wanneer de applicatie eindigt
    }
  end;
end;

end.

 

knuffel

Share this post


Link to post

Bedankt. Ik bouw het verder rustig op. Van algemene opzet naar specifiek detail. De 2 knoppen doen, geloof ik, niet wat beloofd wordt en zijn uitgezet:

unit fmoptions;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Buttons;

type
  TfrmOptions = class(TForm)
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    GroupBox1: TGroupBox;
    chbMRUPath: TCheckBox;
    procedure FormCreate(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmOptions: TfrmOptions;

implementation

uses fmmain;

{$R *.DFM}

procedure TfrmOptions.FormCreate(Sender: TObject);
begin
//  chbMRUPath.Checked := frmMain.mruDB.ShowPath;
end;

procedure TfrmOptions.SpeedButton2Click(Sender: TObject);
begin
  ModalResult := mrCancel;
end;

procedure TfrmOptions.SpeedButton1Click(Sender: TObject);
begin
//  frmMain.mruDB.ShowPath := chbMRUPath.Checked;
  ModalResult := mrCancel;
end;

end.

 

Het formulier is zo:

 

praxis.JPG

Share this post


Link to post
procedure TfrmOptions.SpeedButton1Click(Sender: TObject);
begin
//  frmMain.mruDB.ShowPath := chbMRUPath.Checked;
  ModalResult := mrOK;
end;

Share this post


Link to post
Guest

zie "Object Inspector" knop eigenschap, dan hoeft u niet in code te definiëren wat het resultaat van elke TButton of iets dergelijks zal zijn.

Op deze manier kunt u het resultaat van het formulier evalueren, bijvoorbeeld of uw rendement gelijk was aan de ingedrukte knop of niet;

 

"TSpeedButton" heeft niet de eigenschap "ModalResult", omdat het wordt gebruikt voor situaties waarin u een actie uitvoert zonder het formulier te verlaten.
"TButton" zou daarentegen geschikter zijn voor gebruik in dit formulierscherm, omdat u erop klikt om het formulier te "SLUITEN" (af te sluiten). Begrepen?

 

Dus, zoals hierboven getoond door "Stano", definieer je simpelweg de "ModalResult" waarde van het formulier dat hetzelfde zal zijn als in mijn voorbeeld, maar zorg ervoor dat het nodig zal zijn om de code hiervoor toe te voegen.

procedure TForm2.SpeedButton1Click(Sender: TObject);
begin
  ModalResult := mrOK; // of een andere gelijkwaardige waarde om het formulier te sluiten.
end;

 

TFORM1 = hoofdformulier = de aanvraag

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
  public
  end;
var
  Form1: TForm1;
implementation
{$R *.dfm}

uses
  Unit2;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Form2 := TForm2.Create(nil);
  try
    // u kiest hoe u wilt evalueren
    //
    // Form2.ShowModal;
    //
    // case Form2.ModalResult of
    case Form2.ShowModal of
      mrOk:
        ShowMessage('Button "OK" clicked');
      mrCancel:
        // "Cancel" is default when closing form by "X" button or close command
        ShowMessage('Button "Cancel" clicked');
    else
      ShowMessage('other Button clicked');
    end;
  finally
    FreeAndNil(Form2);
  end;
end;

end.

TFORM2 = tweede formulier dynamisch aanmaken (auto-create = uit) en hier in het hoofdformulier aangeroepen

type
  TForm2 = class(TForm)
    btnMyOKbutton: TButton;
    btnMyCancelButton: TButton;
  private
  public
  end;
var
  Form2: TForm2;
implementation
{$R *.dfm}
end.

image.thumb.png.c7fcd16bb3ba7a9188fb525ab6c8e9db.png

 

hug

Edited by Guest

Share this post


Link to post

Bedankt. Hier een aantal functies:

 

unit fBaseDataObject;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, 
  Forms, Dialogs, DB, DBTables, Wwdatsrc, Wwquery;

type
  TdoBaseDataObject = class(TDataModule)
    qryLijst      : TwwQuery;
    qryObject     : TwwQuery;
    dtsLijst      : TwwDataSource;
    qryInsert     : TwwQuery;
    qryUpdate     : TwwQuery;
    qryDelete     : TwwQuery;
    qryDeleteAll  : TwwQuery;
    qryCheckKey   : TwwQuery;
    qryGetLastKey : TwwQuery;
  private
  protected
    FTableName : string;
    FKeyField  : string;
    FNameField : string;

    FNewCaption : string;
    FNewKeyName : string;

    { genereren we een key zelf of vragen we de gebruiker }
    FAutoGenerateKey : boolean;
    { zijn we bezig een record toe te voegen }
    FInserting    : boolean;
    FWasInserting : boolean;
    { mogen we een database actie doen }
    function CanInsert : Boolean; virtual;
    function CanUpdate : Boolean; virtual;
    function CanPost : Boolean; virtual;
    function CanDelete : Boolean; virtual;
    { haal de nieuwe key op voor een insert }
    procedure GenerateKey; virtual; abstract;

    function ObtainKey: boolean; virtual; abstract;
    function KeyExists : Boolean; virtual; abstract;

    function CreateRecord: boolean; virtual; abstract;

    function Getstate: TDatasetState; virtual;

    procedure LijstRecordChanged(aSender: TObject; aField: TField); virtual;

    procedure SetAutoGenerateKey(aValue: boolean); virtual;

    function GetObjectIsValid: boolean;

  public
    constructor Create( AOwner : TComponent; aTableName,
      aKeyField, aNameField, aNewCaption, aNewKeyName: string ); virtual;

    constructor CreateObject(aOwner: TComponent); virtual; abstract;

    destructor Destroy; override;

    function CanClose: boolean;

    function Insert: boolean; virtual;
    function Edit: boolean; virtual;
    function Cancel: boolean; virtual;
    function Post: boolean; virtual;
    function Delete: boolean; virtual;
    function DeleteAll : Integer; virtual;

    function GetLijst : TwwQuery; virtual;
    procedure CloseLijst; virtual;
    procedure RefreshLijst; virtual;

    function GetObject : TwwQuery; virtual;
    procedure SelectObject; virtual; abstract;
    function LocateObject(aKeyValues: array of const): Boolean; virtual; abstract;

    property State: TDatasetState read Getstate;
    property AutoGenerateKey: boolean read FAutoGenerateKey write SetAutoGenerateKey;
    property ObjectIsValid: boolean read GetObjectIsValid;
  end;

  {var
    DataObject: TDataObject;}

implementation

{$R *.DFM}

uses
  fmConsts, fmMain;

//__________________________________________________________________________________________
function TdoBaseDataObject.CanClose: boolean;
var
  Resultaat : Word;
begin
  Result := true;

  { als de data wordt bewerkt, vraag dan of de veranderingen bewaard moeten worden }
  if (State = dsInsert) or
     (State = dsEdit) then
    begin
      Resultaat := MessageDlg(CONFIRM_APPLY_CHANGES, mtConfirmation, mbYesNoCancel, 0);
      if Resultaat = mrCancel then
        Result := False
      else
        if Resultaat = mrYes then
          Result := Post
        else
          Result := Cancel;
    end;
end;

//__________________________________________________________________________________________
constructor TdoBaseDataObject.Create( AOwner : TComponent;
  aTableName, aKeyField, aNameField, aNewCaption, aNewKeyName: string );
begin
  frmMain.DebugLog('      --> DataObject Create');
  inherited Create( AOwner );

  FTableName := aTableName;
  FKeyField  := aKeyField;
  FNameField := aNameField;

  FNewCaption := aNewCaption;
  FNewKeyName := aNewKeyName;

  { we zijn geen record aan het toevoegen }
  FInserting    := False;
  FWasInserting := False;
  { vraag een nieuwe key aan de gebruiker bij het toevoegen }
  FAutoGenerateKey := False;
  frmMain.DebugLog('      <-- DataObject Create');
end;

//__________________________________________________________________________________________
procedure TdoBaseDataObject.LijstRecordChanged(aSender: TObject; aField: TField);
begin
  {frmMain.DebugLog('--> DataObject LijstRecordChanged');}
  SelectObject;
  {frmMain.DebugLog('<-- DataObject LijstRecordChanged');}
end;

//__________________________________________________________________________________________
destructor TdoBaseDataObject.Destroy;
var
  lintCounter : integer;
begin
  if (State = dsInsert) or
     (State = dsEdit) then
    Cancel;

  { close all the opened datasets }
  for lintCounter := ComponentCount - 1 downto 0 do
    if Components[lintCounter] is TwwQuery then
      begin
        TwwQuery(Components[lintCounter]).Close;
        TwwQuery(Components[lintCounter]).Unprepare;
        //TwwQuery(Components[lintCounter]).Free;
      end;

  inherited Destroy;
end;

//__________________________________________________________________________________________
function TdoBaseDataObject.GetState: TDatasetState;
begin
  if FInserting then
    Result := dsInsert
  else
    Result := qryObject.State;
end;

//__________________________________________________________________________________________
procedure TdoBaseDataObject.SetAutoGenerateKey(aValue: boolean);
begin
  if (aValue <> FAutoGenerateKey) and
     not FInserting then
    FAutoGenerateKey := aValue;
end;

//__________________________________________________________________________________________
function TdoBaseDataObject.GetObjectIsValid: boolean;
begin
  frmMain.DebugLog('--> DataObject GetObjectIsValid');
  Result := ((State <> dsInactive) and not
             (qryObject.Bof and qryObject.Eof));
  frmMain.DebugLog('<-- DataObject GetObjectIsValid');
end;

//__________________________________________________________________________________________
function TdoBaseDataObject.CanInsert: boolean;
begin
  frmMain.DebugLog('    --> DataObject CanInsert');
  Result := True;

  { kijk of we niet aan het editen of inserten zijn }
  if (State = dsInsert) or
       (State = dsEdit) then
    Result := False;

  frmMain.DebugLog('      CanInsert = ' + IntToStr(Integer(Result)));
  frmMain.DebugLog('    <-- DataObject CanInsert');
end;

//__________________________________________________________________________________________
function TdoBaseDataObject.CanUpdate: boolean;
begin
  frmMain.DebugLog('    --> DataObject CanUpdate');
  Result := True;
  { kijk of we niet aan het editen of inserten zijn }
  if FInserting or
       (State <> dsBrowse) then
    Result := False;
  frmMain.DebugLog('      CanUpdate? = ' + IntToStr(Integer(Result)));
  frmMain.DebugLog('    <-- DataObject CanUpdate');
end;

//__________________________________________________________________________________________
function TdoBaseDataObject.CanPost: boolean;
begin
  frmMain.DebugLog('    --> DataObject CanPost');
  Result := True;
  { kijk of we aan het editen of inserten zijn }
  if (State <> dsInsert) and
       (State <> dsEdit) then
    Result := False;
  frmMain.DebugLog('      CanPost? = ' + IntToStr(Integer(Result)));
  frmMain.DebugLog('    <-- DataObject CanPost');
end;

//__________________________________________________________________________________________
function TdoBaseDataObject.CanDelete: boolean;
begin
  frmMain.DebugLog('    --> DataObject CanDelete');
  Result := True;
  { kijk of er een record is en of we niet aan het editen of inserten zijn }
  if FInserting or
       (State <> dsBrowse) or
       (qryObject.Bof and qryObject.Eof) then
    Result := False;

  frmMain.DebugLog('      CanDelete? = ' + IntToStr(Integer(Result)));
  frmMain.DebugLog('    <-- DataObject CanDelete');
end;

//__________________________________________________________________________________________
function TdoBaseDataObject.Insert: boolean;
var
  lbDoInsert : boolean;
begin
  frmMain.DebugLog('  --> DataObject Insert');
  lbDoInsert := True;
  { kijk of een nieuw record toegevoegd mag worden }
  if CanInsert then
    begin
      { als we automatisch een key moeten genereren }
      if FAutoGenerateKey then
        begin
          { maak dan zelf een key aan }
          frmMain.DebugLog('    Key genereren');
          GenerateKey;
        end
      else
        begin
          { en vraag anders een key aan de gebruiker }
          frmMain.DebugLog('    Key aan gebruiker vragen');
          lbDoInsert := ObtainKey;
        end;

      if lbDoInsert then
        begin
          { en voeg het record toe (en selecteer deze!) }
          frmMain.DebugLog('    Create record');
          CreateRecord;

          { en maak er een insert actie van }
          {qryObject.Edit;}
          FInserting := True;
        end;
    end;

  Result := FInserting;

  if Result then
    frmMain.DebugLog('    Insert ok')
  else
    frmMain.DebugLog('    Insert failed!');
  frmMain.DebugLog('  <-- DataObject Insert');
end;

//__________________________________________________________________________________________
function TdoBaseDataObject.Edit: boolean;
begin
  frmMain.DebugLog('--> DataObject Edit');
  Result := False;
  { kijk of het record bewerkt mag worden }
  if CanUpdate then
    begin
      qryObject.Edit;
      Result := True;
      frmMain.DebugLog('  Editing record');
    end;
  frmMain.DebugLog('<-- DataObject Edit');
end;

//__________________________________________________________________________________________
function TdoBaseDataObject.Post: boolean;
begin
  frmMain.DebugLog('--> DataObject Post');
  Result := False;
  if CanPost then
    begin
      frmMain.DebugLog('  Posting record');

      FInserting := False;
      qryObject.Post;

      Result := True;

      frmMain.DebugLog('  Refreshing list');
      if qryLijst.Active then
        RefreshLijst;
    end;
  frmMain.DebugLog('<-- DataObject Post');
end;

//__________________________________________________________________________________________
function TdoBaseDataObject.Delete: boolean;
begin
  frmMain.DebugLog(' --> DataObject Delete');
  Result := False;
  try
    if FWasInserting or (MessageDlg(CONFIRM_DELETE_DATA, mtConfirmation, [mbYes, mbNo], 0) = mrYes) then
      begin
        if FWasInserting or CanDelete then
          begin
            qryObject.Delete;

            Result := True;
            frmMain.DebugLog('   Record deleted!');

            if qryLijst.Active then
              RefreshLijst;
          end
        else
          MessageDlg(DELETE_OBJECT_REFERENCED, mtError, [mbOk], 0);
      end;
  finally
    FWasInserting := False;
  end;
  frmMain.DebugLog(' <-- DataObject Delete');
end;

//__________________________________________________________________________________________
function TdoBaseDataObject.DeleteAll : Integer;
begin
  with qryLijst do
    begin
      try
        DisableControls;
        Open;

        while not EOF do
          begin
            if CanDelete then
              Delete
            else
              Next;
          end;
      finally
        EnableControls;
        Result := RecordCount;
        Close;
      end;
    end;
end;

//__________________________________________________________________________________________
function TdoBaseDataObject.GetLijst : TwwQuery;
begin
  frmMain.DebugLog('--> DataObject GetLijst');
  qryLijst.Open;
  Result := qryLijst;
  frmMain.DebugLog('<-- DataObject GetLijst');
end;

//__________________________________________________________________________________________
procedure TdoBaseDataObject.CloseLijst;
begin
  qryLijst.Close;
end;

//__________________________________________________________________________________________
function TdoBaseDataObject.GetObject : TwwQuery;
begin
  if not qryLijst.Active then
    qryLijst.Open;
  Result := qryObject;
end;

//__________________________________________________________________________________________
procedure TdoBaseDataObject.RefreshLijst;
begin
  qryLijst.Close;
  qryLijst.Open;
end;

//__________________________________________________________________________________________
function TdoBaseDataObject.Cancel: boolean;
var
  lWasInserting : boolean;
begin
  frmMain.DebugLog('--> DataObject Cancel');
  Result := False;
  if (State = dsInsert) or
     (State = dsEdit) then
    begin
      lWasInserting := (State = dsInsert);
      FInserting    := False;
      qryObject.Cancel;
      if lWasInserting then
        begin
          FWasInserting := True;
          Delete;
        end;
      Result := true;
    end;
  frmMain.DebugLog('<-- DataObject Cancel');
end;

end.

Het formulier met de queries:

 

praxis.JPG

Share this post


Link to post
Guest

Ik heb niet veel van de componenten die in dit project worden gebruikt, omdat ik RAD 10.3.3 (Rio) gebruik, en dit project is Delphi 7.
In het bovenstaande geval worden Woll2Woll-componenten (www.woll2woll.com) gebruikt, die destijds de meest gangbare TDatasets, zoals TClientDataset, onder andere uit Borland zelf probeerden te vervangen.
In het algemeen vertegenwoordigt de huidige code een TDataModule, en creëert veel functies die niet echt nodig zijn, en blaast de code op met veel onnodige functies, bijvoorbeeld: controleer of het record wordt bewerkt, invoeging, wat de volgende sleutel is, enzovoort...
Dit kan allemaal gedaan worden als het nodig is om nieuwe procedures / functies te creëren, omdat de "QUERY" componenten (wwQuery of andere) je deze antwoorden kunnen geven.
Zelfs TDataSource dat itereert tussen de "QUERY" -component en de visuele component, bijvoorbeeld TDBGrid, biedt al eigenschappen voor veel van wat de auteur heeft gedaan.
Het zou voor u interessant zijn om alleen in vraag te stellen wat u niet begreep, aangezien ik zie dat er voor zichzelf sprekende opmerkingen in de code staan, en zelfs de naam van de procedures / functies.

 

Er is een nieuwe reeks "PUBLIC" en "PUBLISHED" beschikbaar, zoals gedefinieerd in procedures en variaties in een bepaalde tijd.
Muito disso, nem é needário, de fato!

 

Maar laten we, zoals de auteur destijds deed, hem respecteren.
Gewoonlijk worden dergelijke controles momenteel uitgevoerd: ofwel in de "DATABASE" zelf (op deze manier zal het voor elke toepassing worden gebruikt, zelfs als het niet in DELPHI is aangemaakt), of, in de gebeurtenissen van de gegevenstoegangscomponenten zelf.

 

Wat het doet is: controleer altijd op een conditie om een relevante actie uit te voeren.

 

Mijn advies zou zijn dat je probeert om je eigen code te gaan schrijven met de huidige definities, als je bijvoorbeeld toegang hebt tot de nieuwe editie van Delphi!
Zeer oude code bezoeken, en, zoals deze in Delphi 7, erg slecht in codering, ik geloof dat het je niet veel zal helpen.
Als je wilt, kan ik je helpen bij het ontwikkelen van een "klein project" voor gegevenstoegang, niets te compleet, oké?
Vertel me wat je IDE is (welke versie heb je voor gebruik), het kan zelfs een proefversie zijn van bijvoorbeeld RAD Studio 10.3 die je al veel zal helpen. Als je een andere kunt gebruiken, zeg dan welke.
Ik gebruik RAD Studio 10.3.3 Arch (Rio), als je het kunt gebruiken, laten we dan dezelfde taal spreken. Hoe dan ook, RAD Studio 10.x.x zal het doen, of het nu Seattle, Berlijn, Rio of Sydney is, maar als je dat niet kunt, zullen we zien wat er gebeurt.
Bij voorkeur gebruiken we Delphi met de standaard componenten (die is geïnstalleerd), dus het zou ook helpen.
Zoals ik in dit project zag dat je ondergedompeld bent, gebruikte het componenten van derden, zoals Woll2Woll om toegang te krijgen tot de gegevens (wwQuery), en ik heb het hier niet.
Ik zou je aanraden om een RAD Studio 10 te installeren, om FireDAC te gebruiken, dat nieuwer en gemakkelijker te gebruiken is.

 

knuffel

Share this post


Link to post
Guest

Hier is een klein voorbeeld van iets dat verband houdt met uw laatste bericht.

 

FormMain

unit Unit1;

interface

uses
  Winapi.Windows,
  Winapi.Messages,
  System.SysUtils,
  System.Variants,
  System.Classes,
  Vcl.Graphics,
  Vcl.Controls,
  Vcl.Forms,
  Vcl.Dialogs,
  Vcl.StdCtrls,
  Data.DB,
  Bde.DBTables;

type
  TForm1 = class(TForm)
    Button1: TButton;
    DataSource1: TDataSource;
    Table1: TTable;
    Button2: TButton;
    QueryGetLastKey: TQuery;
    QueryGetLastKeyID: TIntegerField;
    procedure DataSource1StateChange(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Objecten die alleen binnen deze unit te zien zijn, wereldwijd (in alle functies en procedures) }
    FMyPrivatedVar: string;
  protected
    { Objecten die in dit apparaat te zien zijn als er een subklasse is die deze klasse erft
      (TForm1, in het voorbeeld), globaal (in alle functies en procedures) }
    FMyProtectedVar: string;
  public
    { Objecten die in alle units te zien zijn die naar deze unit verwijzen }
    FMyPublicVar: string;
  published
    { een openbare weergave van het object, inclusief de "Object Inspector" van de IDE }
    { meestal gebruikt om "eigenschappen" van de klasse te definiëren }
    property MyPublishedVar: string
      read   FMyPrivatedVar
      write  FMyPrivatedVar;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  lLastID: integer;
begin
  // SQL command on Query1.SQL.Text = 'Select max(ID) from MyTableXXX'
  QueryGetLastKey.open;
  lLastID := QueryGetLastKeyID.Value;
  QueryGetLastKey.Close;
end;

procedure TForm1.DataSource1StateChange(Sender: TObject);
begin
  case (Sender as TDataSource).State of
    dsBrowse:
      { doe iets };
    dsEdit, dsInsert:
      { doe iets };
    //
    // andere "staten", etc...
  else
    { anders doe ik dit ... }
  end;
end;

end.

 

Unit2

unit Unit2;

interface

uses
  Winapi.Windows,
  Winapi.Messages,
  System.SysUtils,
  System.Variants,
  System.Classes,
  Vcl.Graphics,
  Vcl.Controls,
  Vcl.Forms,
  Vcl.Dialogs,
  Vcl.StdCtrls;

type
  TForm2 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form2: TForm2;

implementation

{$R *.dfm}
{
  Een beschermd lid is overal in de module zichtbaar waar zijn klasse is gedeclareerd en vanaf elke afstammende klasse,
  ongeacht de module waarin de afstammende klasse verschijnt. Een beschermde methode kan worden aangeroepen,
  en een beschermd veld of eigenschap kan worden gelezen of geschreven, vanuit de definitie van elke methode
  die behoort tot een klasse die afstamt van degene waar het beschermde lid is gedeclareerd. Leden die alleen bedoeld
  zijn voor gebruik bij de implementatie van afgeleide klassen, worden doorgaans beschermd.
  ------------------

  Gepubliceerde leden hebben dezelfde zichtbaarheid als openbare leden. Het verschil is dat runtime-type-informatie (RTTI) wordt
  gegenereerd voor gepubliceerde leden. Met RTTI kan een toepassing de velden en eigenschappen van een object dynamisch opvragen en de
  methoden ervan lokaliseren. RTTI wordt gebruikt om toegang te krijgen tot de waarden van eigenschappen bij het opslaan en laden van
  formulierbestanden, om eigenschappen weer te geven in de Object Inspector en om specifieke methoden (eventhandlers genoemd)
  te koppelen aan specifieke eigenschappen (events genoemd).
}

{ In het kort:

  Privé-objecten worden over het algemeen alleen gezien binnen de eenheid waarin ze zijn gedefinieerd.
  Ze worden niet rechtstreeks in andere units bekeken. Ze hebben hiervoor een middel nodig, bijvoorbeeld door middel van beveiligde
  objecten.

  beschermde objecten zijn over het algemeen als privéobjecten, ze kunnen ook worden gezien door klassen die zijn gemaakt op basis
  van de bovenliggende klasse. Meestal gebruikt om "eigenschappen" in de klas te creëren.

  openbare objecten kunnen in het algemeen zonder beperkingen in andere eenheden worden gebruikt !!!

  gepubliceerde objecten zijn als openbare objecten, u kunt ze bekijken in de "Object Inspector".
}

{
  Hier is het mogelijk om de variabelen te zien vanwege hun definitie in de bovenliggende klasse.
  Merk op dat u geen directe toegang heeft tot de "FMyPrivatedVar" variabele.

  Via de gepubliceerde eigenschap "MyPublishedVar" hebben we echter toegang tot de waarde van "FMyPrivatedVar".
  Als een proxy, om het te beschermen tegen "ongewenste" wijzigingen.
}

uses
  Unit1;

type
  TMyDescendentTForm1 = class(TForm1); { Een nieuwe klasse maken die de definities van de bovenliggende klasse (TForm1) erft }

  { Toegang krijgen tot objecten van de nieuwe klasse, die zijn gedefinieerd in de bovenliggende klasse }
procedure TForm2.Button1Click(Sender: TObject);
var
  lVarLocalForThisProcedure: string;
begin
  lVarLocalForThisProcedure := Form1.FMyPublicVar;
  lVarLocalForThisProcedure := Form1.MyPublishedVar
end;

{ Toegang krijgen tot objecten van de nieuwe klasse, die zijn gedefinieerd in de bovenliggende klasse }
procedure TForm2.Button2Click(Sender: TObject);
var
  lMyDescFromTForm1: TMyDescendentTForm1; { startpunt om de subklasse te maken }
begin
  lMyDescFromTForm1 := TMyDescendentTForm1.Create(nil); { subklasse in gebruik }
  try
    lMyDescFromTForm1.FMyProtectedVar := 'xxxxx'; { }
    lMyDescFromTForm1.FMyPublicVar    := 'xxxxx';
    //
    lMyDescFromTForm1.MyPublishedVar := 'xxxxx';
  finally
    { het is echter verstandig om te controleren of het object daadwerkelijk is gemaakt, om "toegangsovertreding" te voorkomen }
    if not(lMyDescFromTForm1 = nil) then
    begin
      { uiteindelijk moeten we altijd het geheugen dat door een object is toegewezen, vernietigen of vrijmaken }
      // lMyDescFromTForm1.Free;
      // lMyDescFromTForm1 := nil;
      //
      // of gewoon...
      FreeAndNil(lMyDescFromTForm1); { deze procedure, probeer dan al op de een of andere manier de verificatie hierboven uit te voeren. }
    end;
  end;
end;

end.

 

 

Share this post


Link to post
Guest

U kunt RAD Studio downloaden van de Embarcadero-website om te testen, en als u de "proefversie" langer wilt gebruiken, installeer deze dan op een virtuele machine met MSWindows 7 of 10, zoals vereist door RAD Studio.
Ik heb RAD Studio 10.3.x / 10.4.x geïnstalleerd op een VM die is gemaakt door Oracle's VirtualBox, wat lichtgewicht software is waarmee je heel gemakkelijk je virtuele machines kunt maken.

  • www.embarcadero.com
  • www.virtualbox.org

Ik geef je bijvoorbeeld een tip om aan de slag te gaan:

  1. Download en installeer VirtualBox
  2. maak een VM met MSWindows 10, om elke editie van Delphi te kunnen installeren, inclusief enkele oude.
  3. als u wilt, kan ik u helpen om de toegang tussen uw computer en de virtuele machine te configureren, maar het is heel eenvoudig.
  4. Installeer een editie van RAD Stuido 10 om te beginnen.
Edited by Guest

Share this post


Link to post
unit fBaseDataObjectInteger;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
  fBaseDataObject, Db, Wwdatsrc, DBTables, Wwquery;

type
  TdoBaseDataObjectInteger = class(TdoBaseDataObject)
  private
    { Private declarations }
  protected
    FObjectKey: LongInt;
    { Protected declarations }
  	procedure GenerateKey; override;

  	function ObtainKey: boolean; override;

    function CreateRecord: boolean; override;

    function KeyExists : Boolean; override;

  public
    { Public declarations }
    constructor Create( AOwner : TComponent;
      aTableName, aKeyField, aNameField, aNewCaption, aNewKeyName: string ); override;

    procedure SelectObject; override;
    function LocateObject(aKeyValues: array of const): Boolean; override;

    property NewKey: LongInt read FObjectKey;
  end;

//var
//  doBaseDataObjectInteger : TdoBaseDataObjectInteger;

implementation

uses
  fmmain, // ***** for debugging
  fNewKeyInteger,
  fmconsts;

{$R *.DFM}

//__________________________________________________________________________________________
constructor TdoBaseDataObjectInteger.Create( AOwner : TComponent;
  aTableName, aKeyField, aNameField, aNewCaption, aNewKeyName: string );
begin
  frmMain.DebugLog('   --> TdoBaseDataObjectInteger.Create');
  inherited Create( AOwner, aTableName, aKeyField, aNameField, aNewCaption, aNewKeyName );

  FTableName    := aTableName;
  FKeyField     := aKeyField;
  FNameField    := aNameField;

  FNewCaption := aNewCaption;
  FNewKeyName := aNewKeyName;

  with qryObject do
    begin
      SQL.Clear;
      SQL.Add( 'SELECT * FROM' );
      SQL.Add( FTableName);
      SQL.Add( 'WHERE ' + FKeyField + ' = :prm' + FKeyField );

      ParamByName( 'prm' + FKeyField ).DataType := ftInteger;
      Prepare;
    end;

  with qryLijst do
    begin
      SQL.Clear;
      SQL.Add( 'SELECT * FROM' );
      SQL.Add( FTableName );
      SQL.Add( 'ORDER BY ' + FNameField );
      Prepare;
    end;

  with qryInsert do
    begin
      SQL.Clear;
      SQL.Add( 'INSERT INTO' );
      SQL.Add( FTableName );
      SQL.Add( '  (' + FKeyField + ')' );
      SQL.Add( 'VALUES' );
      SQL.Add( '  (:prm' + FKeyField + ')' );

      ParamByName( 'prm' + FKeyField ).DataType := ftInteger;
      Prepare;
    end;

  with qryCheckKey do
    begin
      SQL.Clear;
      SQL.Add( 'SELECT * FROM' );
      SQL.Add( FTableName );
      SQL.Add( 'WHERE ' + FKeyField + ' = :prm' + FKeyField );

      ParamByName( 'prm' + FKeyField ).DataType := ftInteger;
      Prepare;
    end;

  with qryGetLastKey do
    begin
      SQL.Clear;
      SQL.Add( 'SELECT * FROM' );
      SQL.Add( FTableName );
      SQL.Add( 'ORDER BY ' + FKeyField + ' DESC' );
      Prepare;
    end;
  frmMain.DebugLog('   <-- TdoBaseDataObjectInteger.Create');
end;

//__________________________________________________________________________________________
procedure TdoBaseDataObjectInteger.SelectObject;
begin
  frmMain.DebugLog('  --> doIntegerObject SelectObject');
  with qryObject do
    begin
      Close;
      ParamByName( 'prm' + FKeyField ).asInteger := qryLijst.FieldByName(FKeyField).AsInteger;
      Open;
    end;
  frmMain.DebugLog('  <-- doIntegerObject SelectObject');
end;

{______________________________________________________________________________}
procedure TdoBaseDataObjectInteger.GenerateKey;
begin
  frmMain.DebugLog('    --> doIntegerObject GenerateKey');

  with qryGetLastKey do
    begin
      Close;
      Open;
      FObjectKey := FieldByName(FKeyField).AsInteger + 1;
      Close;
    end;

  frmMain.DebugLog('      Key generated = ' + IntToStr(FObjectKey));
  frmMain.DebugLog('    <-- doIntegerObject GenerateKey');
end;

//__________________________________________________________________________________________
function TdoBaseDataObjectInteger.ObtainKey: boolean;
var
  lForm : TfrmNewKeyInteger;
  lbAskIdAgain: boolean;
begin
  frmMain.DebugLog('    --> doIntegerObject ObtainKey');
  { er is nog geen key gegeven }
  Result := False;

  lForm := TfrmNewKeyInteger.Create(Application);
  try
    lForm.Caption := FNewCaption;
    lForm.KeyName := FNewKeyName;
    lbAskIdAgain := False;
    repeat
      FObjectKey := 0;
      frmMain.DebugLog('      Vraag key..');
      if lForm.ShowModal = mrOk then
      begin
        lbAskIdAgain := False;
        FObjectKey := lForm.NieuweKey;
        frmMain.DebugLog('      Key: ' + IntToStr(FObjectKey));
        if KeyExists then
        begin
          frmMain.DebugLog('      Key bestaat al!');
          lbAskIdAgain := True;
          Messagedlg('Value is already in use', mtError, [mbOk], 0);
        end;
      end
      else
        lbAskIdAgain := False;
    until not lbAskIdAgain;
  finally
    lForm.Release;
  end;

  Result := (FObjectKey > 0);
  frmMain.DebugLog('      Key obtained? = ' + IntToStr(Integer(Result)));
  frmMain.DebugLog('    <-- doIntegerObject ObtainKey');
end;

//__________________________________________________________________________________________
function TdoBaseDataObjectInteger.CreateRecord: boolean;
begin
  frmMain.DebugLog('    --> doIntegerObject CreateRecord');
  frmMain.DebugLog('      Key = ' + IntToStr(FObjectKey));
  if FObjectKey <= 0 then
    raise EFmDbFieldRequired.Create(Format(VALUE_REQUIRED, ['Recordnummer']), FKeyField);

  with qryInsert do
    begin
      Close;
      ParamByName('prm' + FKeyField).AsInteger := FObjectKey;
      ExecSQL;
    end;

  RefreshLijst;

  LocateObject([FObjectKey]);

  frmMain.DebugLog('    <-- doIntegerObject CreateRecord');
end;

//__________________________________________________________________________________________
function TdoBaseDataObjectInteger.KeyExists : Boolean;
begin
	with qryCheckKey do
  begin
  	Close;
    ParamByName( 'prm' + FKeyField ).AsInteger := FObjectKey;
    Open;

    Result := (RecordCount > 0);

    Close;
  end;
end;

//__________________________________________________________________________________________
function TdoBaseDataObjectInteger.LocateObject(aKeyValues: array of const): Boolean;
var
  lBookmark : TBookmark;
begin
  frmMain.DebugLog('--> doIntegerObject LocateObject');
  Result := False;

  if High( aKeyValues ) < 0 then
    raise EFmDbInsufficientParameters.Create( 'Onvoldoende parameters voor opvragen record' );

	with qryLijst do
    begin
      try
        DisableControls;
        dtsLijst.Dataset := nil;

        lBookmark := GetBookmark;

        frmMain.DebugLog('  Looking for: ' + IntToStr(aKeyValues[0].VInteger));
        First;
        while (not Result) and (not Eof) do
          begin
            if FieldByName(FKeyField).AsInteger = aKeyValues[0].VInteger then
              Result := True
            else
              Next;
          end;

        if not Result then
          GotoBookmark(lBookmark)
        else
          SelectObject;
      finally
        EnableControls;
        dtsLijst.Dataset := qryLijst;
        FreeBookmark(lBookmark);
      end;
    end;
  frmMain.DebugLog('      Record located? = ' + IntToStr(Integer(Result)));
  frmMain.DebugLog('<-- doIntegerObject LocateObject');
end;

end.

 

Share this post


Link to post
unit fdbinfothread;

interface

uses
  Forms, Classes, DBTables, SysUtils, fmdmbasic;

type
  TDBInfoStructure = record
    NrOfCompetitions: integer;
    NrOfTeams: integer;
    NrOfPlayers: integer;
    NrOfCoaches: integer;
    NrOfReferees: integer;
    NrOfStadiums: integer;
    NrOfCountries: integer;
    NrOfSeasons: integer;
    NrOfMatches: integer;
  end;
  TDBInfo = ^TDBInfoStructure;

  TDBInfoThread = class(TThread)
  private
    FSession: TSession;
    FQuery: TQuery;
    FPrefix: string;
    FOwner: TForm;
    FDBInfoStructure: TDBInfoStructure;
    FDBInfo: TDBInfo;
  protected
    procedure Execute; override;
    procedure UpdateDatabaseInfo;
  published
    constructor Create(aOwner: TForm; DBName, aPrefix: string; aDBInfo: TDBInfo; aQuery: TQuery);
    destructor Destroy; override;
  end;

implementation

constructor TDBInfoThread.Create(aOwner: TForm; DBName, aPrefix: string; aDBInfo: TDBInfo; aQuery: TQuery);
begin
  inherited Create(false);
  FOwner := aOwner;
  FPrefix := aPrefix;
  FDBInfo := aDBInfo;
  {FSession := TSession.Create(nil);
  FSession.SessionName := IntToStr(ThreadId);
  FSession.OpenDatabase(DBName);
  FQuery := TQuery.Create(nil);
  FQuery.SessionName := FSession.SessionName; }
  FQuery := aQuery;
  with FDBInfoStructure do
  begin
    NrOfCompetitions := 0;
    NrOfTeams := 0;
    NrOfPlayers := 0;
    NrOfCoaches := 0;
    NrOfReferees := 0;
    NrOfStadiums := 0;
    NrOfCountries := 0;
    NrOfSeasons := 0;
    NrOfMatches := 0;
  end;
  FreeOnTerminate := true;
end;

destructor TDBInfoThread.Destroy;
begin
  FSession.Free;
  FQuery.Free;
end;

procedure TDBInfoThread.Execute;
begin
  with FQuery, FDBInfoStructure do
  begin
    Close;
    SQL.Clear;
    SQL.Add('select count(*) nr from');
    SQL.Add(FPrefix+'00.db');
    Open;
    NrOfCompetitions := FieldByName('nr').AsInteger;
    Close;
    SQL[1] := FPrefix+'01.db';
    Open;
    NrOfTeams := FieldByName('nr').AsInteger;
    Close;
    SQL[1] := FPrefix+'02.db';
    Open;
    NrOfPlayers := FieldByName('nr').AsInteger;
    Close;
    SQL[1] := FPrefix+'03.db';
    Open;
    NrOfCoaches := FieldByName('nr').AsInteger;
    Close;
    SQL[1] := FPrefix+'04.db';
    Open;
    NrOfReferees := FieldByName('nr').AsInteger;
    Close;
    SQL[1] := FPrefix+'05.db';
    Open;
    NrOfStadiums := FieldByName('nr').AsInteger;
    Close;
    SQL[1] := FPrefix+'06.db';
    Open;
    NrOfCountries := FieldByName('nr').AsInteger;
    Close;
    SQL[1] := FPrefix+'07.db';
    Open;
    NrOfSeasons := FieldByName('nr').AsInteger;
    Close;
    SQL[1] := FPrefix+'15.db';
    Open;
    NrOfMatches := FieldByName('nr').AsInteger;
    Close;
  end;
  Synchronize(UpdateDatabaseInfo);
end;

procedure TDBInfoThread.UpdateDatabaseInfo;
begin
  FDBInfo^ := FDBInfoStructure;
end;

end.

 

Share this post


Link to post
unit fDebugLog;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, 
  Forms, Dialogs, StdCtrls;

type
  TfrmDebugLog = class(TForm)
    mmoDebugLog : TMemo;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
    FDebugLogFile : TextFile;
  public
    { Public declarations }
    procedure WriteToDebugLog(Msg: string);
  end;

var
  frmDebugLog : TfrmDebugLog;

implementation

{$R *.DFM}

uses
  fmConsts;

procedure TfrmDebugLog.FormCreate(Sender: TObject);
begin
  Left := 0;
  Top  := 0;
  if USE_DEBUG_LOG_FILE then
    begin
      AssignFile(FDebugLogFile, ExtractfilePath(Application.ExeName) + 'Debuglog ' + FormatDateTime('dd-mm-yyyy hhnn', Now) + '.txt');
      Rewrite(FDebugLogFile);
    end;
end;

procedure TfrmDebugLog.WriteToDebugLog(Msg: string);
begin
  with mmoDebugLog do
    begin
      Lines.Add(TimeToStr(Time) + ': ' + Msg);
      if USE_DEBUG_LOG_FILE then
        WriteLn(FDebugLogFile, TimeToStr(Time) + ': ' + Msg);
      SelectAll;
      Selstart := SelLength;
    end;
end;

procedure TfrmDebugLog.FormDestroy(Sender: TObject);
begin
  if USE_DEBUG_LOG_FILE then
    CloseFile(FDebugLogFile);
end;

end.

 

praxis.JPG

Share this post


Link to post
Guest

Hier slaat de auteur de inhoud van het memologboek op een schijfbestand op.

 

Quote

AssignFile(FDebugLogFile, ExtractfilePath(Application.ExeName) + 'Debuglog ' + FormatDateTime('dd-mm-yyyy hhnn', Now) + '.txt');
Rewrite(FDebugLogFile);

CloseFile(FDebugLogFile);

Bij het maken van het formulier verwijst het naar een bestand op de schijf (als het bestaat, wordt het gemaakt als het niet bestaat)
Opent het bestand voor opname.
Sluit het bestand bij het sluiten van het formulier

Share this post


Link to post
Guest
1 hour ago, Johnny Smash said:

unit fdbinfothread;

Hier maakt het een beetje ingewikkeld, omdat het "THREAD" gebruikt om (zoiets als) taken op de achtergrond te automatiseren, tabellen te openen en te sluiten, en aan het einde synchroniseert het met de hoofd "Thread", de applicatie zelf, dat wil zeggen , het formulier op het scherm. Zoiets.

Share this post


Link to post

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now

×