Johnny Smash 0 Posted January 13, 2021 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 Posted January 13, 2021 Ahhhhhhhhhhhhh!!!! help help b 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
Johnny Smash 0 Posted January 13, 2021 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: Share this post Link to post
Daniel 417 Posted January 13, 2021 Please try to use the English language. And please post longer code-segments as file-attachments. Share this post Link to post
Stano 143 Posted January 13, 2021 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 Share this post Link to post
Guest Posted January 14, 2021 (edited) 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? 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 January 14, 2021 by Guest Share this post Link to post
Johnny Smash 0 Posted January 14, 2021 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
Johnny Smash 0 Posted January 14, 2021 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: Share this post Link to post
Stano 143 Posted January 14, 2021 (edited) Use help first. Place the cursor in / on the (caFree) keyword and press F1 Close = Self.Close = FormAbout.Close = onFormClose Edited January 14, 2021 by Stano Share this post Link to post
Johnny Smash 0 Posted January 15, 2021 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: Share this post Link to post
Guest Posted January 15, 2021 (edited) 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 January 15, 2021 by Guest Share this post Link to post
Guest Posted January 15, 2021 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 Posted January 15, 2021 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
Johnny Smash 0 Posted January 16, 2021 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: Share this post Link to post
Stano 143 Posted January 16, 2021 procedure TfrmOptions.SpeedButton1Click(Sender: TObject); begin // frmMain.mruDB.ShowPath := chbMRUPath.Checked; ModalResult := mrOK; end; Share this post Link to post
Guest Posted January 16, 2021 (edited) 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. hug Edited January 16, 2021 by Guest Share this post Link to post
Johnny Smash 0 Posted January 17, 2021 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: Share this post Link to post
Guest Posted January 17, 2021 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 Posted January 17, 2021 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 Posted January 17, 2021 (edited) 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: Download en installeer VirtualBox maak een VM met MSWindows 10, om elke editie van Delphi te kunnen installeren, inclusief enkele oude. als u wilt, kan ik u helpen om de toegang tussen uw computer en de virtuele machine te configureren, maar het is heel eenvoudig. Installeer een editie van RAD Stuido 10 om te beginnen. Edited January 17, 2021 by Guest Share this post Link to post
Johnny Smash 0 Posted January 18, 2021 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
Johnny Smash 0 Posted January 18, 2021 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
Johnny Smash 0 Posted January 18, 2021 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. Share this post Link to post
Guest Posted January 18, 2021 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 Posted January 18, 2021 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
![Delphi-PRAXiS [en]](https://en.delphipraxis.net/uploads/monthly_2018_12/logo.png.be76d93fcd709295cb24de51900e5888.png){kind=logo}
