unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, Forms, Dialogs, StdCtrls;
type
{ TForm1 }
TForm1 = class(TForm)
Button1: TButton;
Label1: TLabel;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
FCurrent: Integer;
function VersionName(Value: Integer): string;
end;
var
Form1: TForm1;
const
Filename = 'version.txt';
MaxVersion = 3;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
var
aFile: Text;
aValue: Integer;
begin
// Load version information
FCurrent := 0;
AssignFile(aFile, Filename);
try
Reset(aFile);
ReadLn(aFile, aValue);
CloseFile(aFile);
FCurrent := aValue;
except
ShowMessage('Unable to load version info.');
end;
// Display the version
Label1.Caption := 'You''re currently using ' + VersionName(FCurrent) + '.';
// Set button caption
Button1.Caption := 'Click me to change to' + LineEnding +
VersionName(FCurrent+1) + LineEnding +
'on next program start.';
end;
procedure TForm1.Button1Click(Sender: TObject);
var
aFile: Text;
aValue: Integer;
begin
aValue := FCurrent + 1;
if aValue > MaxVersion then aValue := 0;
AssignFile(aFile, Filename);
try
Rewrite(aFile);
Write(aFile, aValue);
CloseFile(aFile);
except
ShowMessage('File updating failed.');
end;
end;
function TForm1.VersionName(Value: Integer): string;
begin
case Value of
0: Result := 'Prelease';
1: Result := 'Stable';
2: Result := 'Unstable';
else
Result := 'Unofficial';
end;
// Remove this line below if you don't want to cycle back to the beginning
if Value > MaxVersion then Result := 'Prelease';
Result := Result + ' version';
end;
end.