Johnny Smash

Well, Stano, grdselection1 and grdselection2 were both a TwwDBGrid (Woll2Woll). Now they are of TDBGrid.

Clear Lars. But this is not my doing. It is the coding of somebody else. It is part of a program. I am trying to change all the InfoPower components from Woll2Woll back to standard Delphi ones. Delphi sees 'Selected, Clear, Add and ApplySelected' each as a "undeclared identifier" and halts. What could be the cause of this error you think, please?

Welcome back. Now I have a piece of source code, which is bothering me. Compiling is hold on this part: with grdSelection1 do begin Selected.Clear; Selected.Add('BackNr' + #9 + '3'+ #9 + 'Nr'); Selected.Add('FullName' + #9 + '20'+ #9 + 'Player'); Selected.Add('MinutesInMatch' + #9 + '3'+ #9 + 'Min'); ApplySelected; end; Delphi sees 'Selected, Clear, Add and ApplySelected' each as a "undeclared identifier". So what is going wrong? Is an external component missing? Do I need to declare a variable? Does anybody have an idea, please?

Ja, Lars. Daniel advarede mig allerede (see qote). Men jeg venter på, at emailx45 skal svare mig. Han arbejder på et problem. Snart slutter dette indlæg alligevel.

unit sqlconst; interface uses classes, SysUtils; const SQL_MATCH_COUNT = 29; SQL_MATCH : array[0..SQL_MATCH_COUNT -1] of string = ('SELECT Match.SeasonId, Match.RoundNr, Match.GroupNr, Match.MatchNr, Match.MatchId,', ' Match.Return, Match.Team1Id, Match.Team2Id, Match.Winner, Match.MatchDateTime,', ' Match.InTabelle, Match.StadiumId, Match.RefereeId, Match.Text, Match.Visitors, Match.Coach1Id,', ' Match.Coach2Id, Match.SpToreStr1, Match.SpToreStr2, Match.SpPunkte1, Match.SpPunkte2,', ' Match.SpPunkte3, Match.SpPunkte4, Match.SpBilanz1, Match.SpBilanz2, Match.SpTore1,', ' Match.SpTore2, Match.SpTore3, Match.SpTore4, Match.StaWertung, Match.SchiriKosten,', ' Match.SelectFeld, Team1.TeamId tm1TeamId, Team1.TeamName tm1TeamName, Team1.Country tm1Country,', ' Team2.TeamId tm2TeamId, Team2.TeamName tm2TeamName, Team2.Country tm2Country,', ' Coach1.CoachId co1CoachId, Coach1.FullName co1FullName, Coach1.Nationality co1Nationality,', ' Coach2.CoachId co2CoachId, Coach2.FullName co2FullName, Coach2.Nationality co2Nationality,', ' Referee.RefereeId refRefereeId, Referee.FullName refFullName, Referee.Nationality, Stadium.StadiumId staStadiumId,', ' Stadium.FullName staFullName, Stadium.Capacity staCapacity, Stadium.Country staCountry', 'FROM "PREFIX15.DB" Match', ' LEFT OUTER JOIN "PREFIX01.DB" Team1', ' ON (Match.Team1Id = Team1.TeamId)', ' LEFT OUTER JOIN "PREFIX01.DB" Team2', ' ON (Match.Team2Id = Team2.TeamId)', ' LEFT OUTER JOIN "PREFIX03.DB" Coach1', ' ON (Match.Coach1Id = Coach1.CoachId)', ' LEFT OUTER JOIN "PREFIX03.DB" Coach2', ' ON (Match.Coach2Id = Coach2.CoachId)', ' LEFT OUTER JOIN "PREFIX04.DB" Referee', ' ON (Match.RefereeId = Referee.RefereeId)', ' LEFT OUTER JOIN "PREFIX05.DB" Stadium', ' ON (Match.StadiumId = Stadium.StadiumId)', 'WHERE (Match.SeasonId = :prmSeasonId)', ' AND (Match.RoundNr = :prmRoundNr)', ' AND (Match.GroupNr = :prmGroupNr)', ' AND (Match.MatchNr = :prmMatchNr)'); SQL_MATCH_SELECTION_COUNT = 5; SQL_MATCH_SELECTION : array[0..SQL_MATCH_SELECTION_COUNT -1] of string = ('select *', 'from "PREFIX16.db" pim, "PREFIX02.db" pla', 'where (pim.PlayerId = pla.PlayerId)', ' and (MatchId = :prmMatchId)', 'order by PlaysForTeam, BackNr'); SQL_MATCH_EVENTS_COUNT = 6; SQL_MATCH_EVENTS : array[0..SQL_MATCH_EVENTS_COUNT -1] of string = ('SELECT Goal.MatchId, Goal.PlayerId, Goal.GoalMinute, Goal.GoalForTeam, Goal.OwnGoal, Goal.Comment, Player.FullName', 'FROM "PREFIX17.DB" Goal', ' LEFT OUTER JOIN "PREFIX02.DB" Player', ' ON (Goal.PlayerId = Player.PlayerId)', 'WHERE (Goal.MatchId = :prmMatchId)', 'ORDER BY Goal.GoalMinute'); procedure UpdateSqlPrefixes(SQL: TStrings; Prefix: string); implementation procedure UpdateSqlPrefixes(SQL: TStrings; Prefix: string); var Regel: integer; p: integer; begin for Regel := 0 to SQL.Count - 1 do begin p := Pos('PREFIX', SQL[Regel]); while (p > 0) do begin SQL[Regel] := Copy(SQL[Regel], 1, p-1) + Prefix + Copy(SQL[Regel], p + 6, Length(SQL[Regel]) - p - 5); p := Pos('PREFIX', SQL[Regel]); end; end; end; // UpdateSqlPrefixes end.

unit dstat; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Db, DBTables, Wwquery; type TdtmStat = class(TDataModule) qryMatch: TwwQuery; qryMatchSelection: TwwQuery; qryMatchEvents: TwwQuery; procedure dtmStatDestroy(Sender: TObject); private FDatabase: TDatabase; public procedure SetDatabaseToUse(aDatabase: TDatabase); procedure UpdateQueries(aPrefix: string); procedure CloseQueries; end; var dtmStat: TdtmStat; implementation {$R *.DFM} uses sqlconst; //__________________________________________________________________________________________ procedure TdtmStat.SetDatabaseToUse(aDatabase: TDatabase); begin FDatabase := aDatabase; qryMatch.DatabaseName := FDatabase.DatabaseName; qryMatchSelection.DatabaseName := FDatabase.DatabaseName; qryMatchEvents.DatabaseName := FDatabase.DatabaseName; end; // SetDatabaseToUse //__________________________________________________________________________________________ procedure TdtmStat.UpdateQueries(aPrefix: string); begin UpdateSqlPrefixes(qryMatch.SQL, aPrefix); UpdateSqlPrefixes(qryMatchSelection.SQL, aPrefix); UpdateSqlPrefixes(qryMatchEvents.SQL, aPrefix); // en bereid de queries voor qryMatch.Prepare; qryMatchSelection.Prepare; qryMatchEvents.Prepare; end; // UpdateQueries //__________________________________________________________________________________________ procedure TdtmStat.dtmStatDestroy(Sender: TObject); begin // unprepare de queries if qryMatch.Prepared then qryMatch.UnPrepare; if qryMatchSelection.Prepared then qryMatchSelection.UnPrepare; if qryMatchEvents.Prepared then qryMatchEvents.UnPrepare; // en sluit ze qryMatch.Close; qryMatchSelection.Close; qryMatchEvents.Close; end; // dtmStatDestroy //__________________________________________________________________________________________ procedure TdtmStat.CloseQueries; begin qryMatch.Close; qryMatchSelection.Close; qryMatchEvents.Close; // unprepare de queries if qryMatch.Prepared then qryMatch.UnPrepare; if qryMatchSelection.Prepared then qryMatchSelection.UnPrepare; if qryMatchEvents.Prepared then qryMatchEvents.UnPrepare; end; // CloseQueries end.

unit fNewKeyInteger; interface uses SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls; type TfrmNewKeyInteger = class(TForm) pnlData: TPanel; pnlCommands: TPanel; pnlSluiten: TPanel; cmdOk: TButton; cmdAnnuleer: TButton; lblKeyName: TLabel; txtNieuweKey: TEdit; procedure FormActivate(Sender: TObject); procedure cmdOkClick(Sender: TObject); private { Private declarations } function GetNieuweKey: integer; procedure SetNieuweKey(aValue: integer); procedure SetKeyName(aValue: string); public { Public declarations } property NieuweKey: integer read GetNieuweKey write SetNieuweKey; property KeyName: string write SetKeyName; end; implementation {$R *.DFM} uses fmConsts; procedure TfrmNewKeyInteger.FormActivate(Sender: TObject); begin txtNieuweKey.SetFocus; txtNieuweKey.Text := ''; end; function TfrmNewKeyInteger.GetNieuweKey: integer; begin Result := StrToIntDef(txtNieuweKey.Text, 0); end; procedure TfrmNewKeyInteger.SetNieuweKey(aValue: integer); begin txtNieuweKey.Text := IntToStr(aValue); end; procedure TfrmNewKeyInteger.SetKeyName(aValue: string); begin lblKeyName.Caption := aValue; end; procedure TfrmNewKeyInteger.cmdOkClick(Sender: TObject); begin if txtNieuweKey.Text <> '' then begin if (StrToIntDef(txtNieuweKey.Text, 0) > 0) then ModalResult := mrOk else begin MessageDlg('Please enter a positive number', mtError, [mbOk], 0); txtNieuweKey.SetFocus; end; end else begin Messagedlg(Format(VALUE_REQUIRED, [lblKeyName.Caption]), mtError, [mbOk], 0); txtNieuweKey.SetFocus; end; end; end.

unit fmconsts; interface uses forms, classes, SysUtils; const // do we use the debug log? USE_DEBUG_LOG = True; USE_DEBUG_LOG_FILE = False; // database messages CONFIRM_DELETE_DATA = 'The data is about to be deleted. Are you sure?'; CONFIRM_APPLY_CHANGES = 'The data has changed. Save changes?'; DELETE_OBJECT_REFERENCED = 'There are references to this object. It can''t be deleted.'; VALUE_REQUIRED = 'Please enter a value for field ''%s''.'; // constants for data objects SEASON_TABLE_NAME = 'TESTER07.DB'; SEASON_KEY_FIELD = 'SeasonId'; SEASON_NAME_FIELD = 'SeasonName'; SEASON_NEW_CAPTION = 'New season'; SEASON_NEW_KEYNAME = 'Season no.'; MATCH_TABLE_NAME = 'TESTER15.DB'; MATCH_KEY_FIELD = 'MatchNr'; MATCH_NAME_FIELD = 'MatchId'; MATCH_NEW_CAPTION = 'New match'; MATCH_NEW_KEYNAME = 'Match no.'; // pages on basic data form PAGE_TOPIC: array[0..8] of string = ('competition', 'team', 'player', 'coach', 'referee', 'stadium', 'country', 'position', 'system'); // positions on the field FIELD_POSITION: array[0..22] of string = ('Unknown', 'Defense', 'Goalkeeper', 'Sweeper', 'Left back', 'Left centre back', 'Centre back', 'Right centre back', 'Right back', 'Midfield', 'Defensive midfield', 'Left half', 'Centre half', 'Right half', 'Forward midfield', 'Forward', 'Inside left', 'Inside right', 'Outside left', 'Left centre forward', 'Centre forward', 'Right centre forward', 'Outside right'); // known systems FIELD_SYSTEMS: array[0..23,0..5] of string = (('Year', 'K', 'D', 'M', 'F', 'Name'), ('1920', '1', '2', '3', '5', 'MM/ACH'), ('1930', '1', '3', '2', '5', 'WM/DCH'), ('1935', '1', '3', '3', '4', 'Verrou'), ('1941', '1', '3', '4', '3', 'Diagonal'), ('1984', '1', '3', '5', '2', 'sweeper/diamond/flat'), ('1950', '1', '4', '2', '4', 'sweeper/flat/flat'), ('1952', '1', '4', '2', '4', 'flat/flat/flat'), ('1942', '1', '4', '3', '3', 'Muralha'), ('1962', '1', '4', '3', '3', 'flat/flat/flat'), ('', '1', '4', '3', '3', 'flat/dm/flat'), ('', '1', '4', '3', '3', 'flat/fm/flat'), ('1974', '1', '4', '3', '3', 'sweeper/flat/flat'), ('', '1', '4', '3', '3', 'sweeper/dm/flat'), ('', '1', '4', '3', '3', 'sweeper/fm/flat'), ('1982', '1', '4', '4', '2', 'flat/diamond/flat'), ('1986', '1', '4', '4', '2', 'sweeper/diamond/flat'), ('', '1', '4', '5', '1', 'flat/diamond/flat'), ('', '1', '4', '5', '1', 'sweeper/diamond/flat'), ('1960', '1', '5', '2', '3', 'sweeper/flat/flat'), ('', '1', '5', '3', '2', 'sweeper/flat/flat'), ('1984', '1', '5', '3', '2', 'sweeper/dm/flat'), ('', '1', '5', '3', '2', 'sweeper/fm/flat'), ('', '1', '5', '4', '1', 'sweeper/diamond/flat')); // descriptions of rounds ROUND_DESCR_001 = 'Not fixed'; ROUND_DESCR_002 = 'Group round'; ROUND_DESCR_014 = '1/64 finals'; ROUND_DESCR_015 = '1/32 finals'; ROUND_DESCR_016 = '1/16 finals'; ROUND_DESCR_017 = '1/8 finals'; ROUND_DESCR_018 = 'Quarter-finals'; ROUND_DESCR_019 = 'Semi-finals'; ROUND_DESCR_020 = 'Final'; ROUND_DESCR_103 = 'Play for 3rd place'; ROUND_DESCR_105 = 'Play for 5rd place'; ROUND_DESCR_107 = 'Play for 7rd place'; ROUND_DESCR_109 = 'Play for 9rd place'; ROUND_DESCR_111 = 'Play for 11rd place'; ROUND_DESCR_113 = 'Play for 13rd place'; ROUND_DESCR_115 = 'Play for 15rd place'; ROUND_DESCR_117 = 'Play for 17rd place'; // error codes ERROR_NO_ERROR = 0; ERROR_INITIALIZE = -1; ERROR_EXECUTE = -2; ERROR_FINALIZE = -3; ERROR_OPEN_DATABASE = -4; ERROR_NO_RECORD = -5; type EFmException = class(Exception); EFmDatabaseException = class(EFmException); EFmDbInsufficientParameters = class(EFmDatabaseException); EFmDbIntegrityViolation = class(EFmDatabaseException); EFmDbFieldException = class(EFmDatabaseException) private FFieldName: string; public constructor Create(const Msg, aFieldName: String); {override;} property FieldName: string read FFieldName write FFieldName; end; EFmDbFieldRequired = class(EFmDbFieldException); // query sort procedure types TfgSortType = (stByName, stByCountry, stDontCare); TfgNational = (inDontCare, inYes, inNo); TSortProcedure = procedure (SortType: TfgSortType; IsNational: TfgNational) of object; // types for basic data pagecontrol TPageNumber = Byte; TExternalPages = set of TPageNumber; TIdForm = (ifCompetition, ifTeam, ifPlayer, ifCoach, ifReferee, ifStadium, ifCountry); TfvgFormState = (fsUnknown, fsBrowsing, fsEditing, fsInserting); TOwnEditForm = class(TForm) private FCurrentRecordId: integer; FFormState: TfvgFormState; constructor Create(AOwner: TComponent); override; procedure SetFormstate(Value: TfvgFormState); public procedure InitializeForm; dynamic; procedure UpdateFormState; dynamic; property FormState: TfvgFormState read FFormState write SetFormstate; property CurrentRecordId: integer read FCurrentRecordId write FCurrentRecordId; // key of current season end; implementation //__________________________________________________________________________________________ constructor EFmDbFieldException.Create(const Msg, aFieldName: String); begin {inherited Create(Msg);} Message := Msg; FFieldName := aFieldName; end; //__________________________________________________________________________________________ constructor TOwnEditForm.Create(AOwner: TComponent); begin inherited Create(AOwner); //FCurrentRecordId := -1; //FFormState := fsBrowsing; end; // Create //__________________________________________________________________________________________ procedure TOwnEditForm.SetFormstate(Value: TfvgFormState); begin if Value <> FFormState then begin FFormState := Value; UpdateFormState; end; end; // SetFormstate //__________________________________________________________________________________________ procedure TOwnEditForm.InitializeForm; begin // end; // InitializeForm //__________________________________________________________________________________________ procedure TOwnEditForm.UpdateFormState; begin // end; // UpdateFormState end.

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.

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.

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.

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:

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:

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:

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: