Jump to content

Johnny Smash

Members
  • Content Count

    7
  • Joined

  • Last visited

Community Reputation

0 Neutral

Technical Information

  • Delphi-Version
    Delphi 2 - 7

Recent Profile Visitors

20 profile views
  1. Johnny Smash

    Footman

    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:
  2. Johnny Smash

    Footman

    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:
  3. Johnny Smash

    Footman

    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:
  4. Johnny Smash

    Footman

    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:
  5. Johnny Smash

    Footman

    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.
  6. Johnny Smash

    Footman

    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:
  7. Johnny Smash

    Footman

    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.?
×