mirror of
https://bitbucket.org/grumdrig/pq.git
synced 2026-09-29 00:33:59 -06:00
Eric Fredricksen
a1fa177943
svn, so that changes will be trackable thataway This is version 6.1 as found in the old sources. Used whathappened.py to update it.
1345 lines
37 KiB
ObjectPascal
1345 lines
37 KiB
ObjectPascal
unit Main;
|
|
{ copyright (c)2002 Eric Fredricksen all rights reserved }
|
|
|
|
interface
|
|
|
|
uses
|
|
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
|
|
Dialogs, ComCtrls, StdCtrls, ExtCtrls, Buttons, ImgList, Menus, Psock,
|
|
NMHttp, ShellAPI;
|
|
|
|
const
|
|
RevString = '&rev=3';
|
|
wmIconTray = WM_USER + Ord('t');
|
|
|
|
type
|
|
TMainForm = class(TForm)
|
|
Panel1: TPanel;
|
|
Label1: TLabel;
|
|
Traits: TListView;
|
|
Equips: TListView;
|
|
Panel3: TPanel;
|
|
Label3: TLabel;
|
|
QuestBar: TProgressBar;
|
|
Stats: TListView;
|
|
Label2: TLabel;
|
|
PlotBar: TProgressBar;
|
|
Plots: TListView;
|
|
Quests: TListView;
|
|
Panel2: TPanel;
|
|
Label4: TLabel;
|
|
Spells: TListView;
|
|
InventoryLabelAlsoGameStyle: TLabel;
|
|
Inventory: TListView;
|
|
Panel4: TPanel;
|
|
Kill: TStatusBar;
|
|
Label6: TLabel;
|
|
ExpBar: TProgressBar;
|
|
TaskBar: TProgressBar;
|
|
Timer1: TTimer;
|
|
EncumBar: TProgressBar;
|
|
Label7: TLabel;
|
|
ImageList1: TImageList;
|
|
Label8: TLabel;
|
|
Cheats: TPanel;
|
|
CashIn: TButton;
|
|
Button1: TButton;
|
|
FinishQuest: TButton;
|
|
Button3: TButton;
|
|
CheatPlot: TButton;
|
|
vars: TPanel;
|
|
fTask: TLabel;
|
|
fQuest: TLabel;
|
|
fQueue: TListBox;
|
|
procedure GoButtonClick(Sender: TObject);
|
|
procedure Timer1Timer(Sender: TObject);
|
|
procedure FormCreate(Sender: TObject);
|
|
procedure SpeedButton1Click(Sender: TObject);
|
|
procedure FormShow(Sender: TObject);
|
|
procedure Button1Click(Sender: TObject);
|
|
procedure CashInClick(Sender: TObject);
|
|
procedure FinishQuestClick(Sender: TObject);
|
|
procedure CheatPlotClick(Sender: TObject);
|
|
procedure FormClose(Sender: TObject; var Action: TCloseAction);
|
|
procedure FormKeyDown(Sender: TObject; var Key: Word;
|
|
Shift: TShiftState);
|
|
private
|
|
procedure Task(caption: String; msec: Integer);
|
|
procedure Dequeue;
|
|
procedure Q(s: string);
|
|
function TaskDone: Boolean;
|
|
procedure CompleteQuest;
|
|
procedure CompleteAct;
|
|
procedure WinEquip;
|
|
procedure WinSpell;
|
|
procedure WinStat;
|
|
procedure WinItem;
|
|
function SpecialItem: String;
|
|
procedure LevelUp;
|
|
function BoringItem: String;
|
|
function InterestingItem: String;
|
|
function MonsterTask(var level: Integer): String;
|
|
function EquipPrice: Integer;
|
|
procedure Brag(trigger: String);
|
|
procedure TriggerAutosizes;
|
|
function GameSaveName: String;
|
|
procedure OnTrayMessage(var Msg: TMessage); message wmIconTray;
|
|
procedure OnSysCommand(Var Msg : TWMSysCommand); message WM_SYSCOMMAND;
|
|
procedure Guildify;
|
|
procedure ClearAllSelections;
|
|
public
|
|
FTrayIcon: TNotifyIconData;
|
|
procedure MinimizeIt;
|
|
procedure LoadGame(name: String);
|
|
function SaveGame: Boolean;
|
|
procedure Put(list: TListView; key: String; value: String); overload;
|
|
procedure Put(list: TListView; pos: Integer; value: String); overload;
|
|
procedure Put(list: TListView; key: String; value: Integer); overload;
|
|
procedure Add(list: TListView; key: String; value: Integer); overload;
|
|
procedure AddR(list: TListView; key: String; value: Integer); overload;
|
|
function Get(list: TListView; key: String): String; overload;
|
|
function Get(list: TListView; index: Integer): String; overload;
|
|
function GetI(list: TListView; key: String): Integer; overload;
|
|
function GetI(list: TListView; index: Integer): Integer; overload;
|
|
function Sum(list: TListView): Integer;
|
|
function RollCharacter: Boolean;
|
|
function GetMotto: String;
|
|
function GetPasskey: Integer;
|
|
procedure SetMotto(v: String);
|
|
procedure SetPasskey(v: String);
|
|
function GetHostAddr: String;
|
|
function GetHostName: String;
|
|
procedure SetHostAddr(v: String);
|
|
procedure SetHostName(v: String);
|
|
function GetLogin: String;
|
|
function GetPassword: String;
|
|
procedure SetLogin(v: String);
|
|
procedure SetPassword(v: String);
|
|
function GetGuild: String;
|
|
procedure SetGuild(v: String);
|
|
end;
|
|
|
|
var
|
|
MainForm: TMainForm;
|
|
|
|
function Split(s: String; field: Integer): String;
|
|
|
|
procedure Navigate(url: String);
|
|
|
|
implementation
|
|
|
|
uses NewGuy, Math, Config, Front, zlibex, SelServ, Login, mmsystem;
|
|
|
|
{$R *.dfm}
|
|
{ D E F I N E CHEATS}
|
|
|
|
procedure MakeFileAssociations;
|
|
begin
|
|
// HKCR/.pq (Default)="pqfile"
|
|
// HKCR/pqfile (Default)="Progress Quest saved game"
|
|
// HKCR/pqfile/shell (Default)="open"
|
|
// HKCR/pqfile/shell/open/command (Default)='c:\blah\pq.exe "%1"'
|
|
end;
|
|
|
|
procedure TMainForm.MinimizeIt;
|
|
begin
|
|
with FTrayIcon do
|
|
begin
|
|
cbSize := SizeOf(FTrayIcon);
|
|
Wnd := Handle;
|
|
uID := 0;
|
|
uFlags := NIF_MESSAGE + NIF_ICON + NIF_TIP;
|
|
uCallbackMessage := wmIconTray;
|
|
hIcon := Application.Icon.Handle;
|
|
StrPCopy(szTip, Application.Title);
|
|
//a.szTip := 'Progress Quest';
|
|
end;
|
|
Application.Minimize;
|
|
ShowWindow(Application.Handle, SW_HIDE);
|
|
Shell_NotifyIcon(NIM_ADD,@FTrayIcon);
|
|
end;
|
|
|
|
procedure TMainForm.OnSysCommand(var Msg: TWMSysCommand);
|
|
begin
|
|
if (Msg.CmdType = SC_MINIMIZE) then
|
|
MinimizeIt();
|
|
inherited;
|
|
end;
|
|
|
|
procedure TMainForm.OnTrayMessage(var Msg: TMessage);
|
|
var
|
|
p : TPoint;
|
|
begin
|
|
case Msg.lParam of
|
|
WM_LBUTTONDOWN, WM_RBUTTONDOWN:
|
|
begin
|
|
ShowWindow(Application.Handle, SW_SHOW);
|
|
Application.Restore;
|
|
Shell_NotifyIcon(NIM_DELETE, @MainForm.FTrayIcon);
|
|
end;
|
|
{ WM_RBUTTONDOWN:
|
|
begin
|
|
//SetForegroundWindow(Handle);
|
|
//GetCursorPos(p);
|
|
//PopUpMenu1.Popup(p.x, p.y);
|
|
//PostMessage(Handle, WM_NULL, 0, 0);
|
|
end;
|
|
}
|
|
end;
|
|
end;
|
|
|
|
procedure StartTimer;
|
|
begin
|
|
if not MainForm.Timer1.Enabled then begin
|
|
MainForm.Timer1.Tag := timeGetTime;
|
|
//Shell_NotifyIcon(NIM_ADD, @MainForm.FTrayIcon);
|
|
end;
|
|
MainForm.Timer1.Enabled := True;
|
|
end;
|
|
|
|
function TMainForm.GetPasskey: Integer; begin Result := Traits.Tag; end;
|
|
procedure TMainForm.SetPasskey(v: String);
|
|
begin
|
|
Traits.Hint := v;
|
|
Traits.Tag := StrToIntDef(Traits.Hint,0);
|
|
end;
|
|
|
|
function TMainForm.GetMotto: String; begin Result := Stats.Hint; end;
|
|
procedure TMainForm.SetMotto(v: String); begin Stats.Hint := v; end;
|
|
|
|
function TMainForm.GetHostName: String; begin Result := Spells.Hint; end;
|
|
procedure TMainForm.SetHostName(v: String); begin Spells.Hint := v; end;
|
|
|
|
function TMainForm.GetHostAddr: String;
|
|
begin
|
|
Result := Equips.Hint;
|
|
if (Result = '') and (GetPasskey <> 0) then
|
|
Result := 'http://www.progressquest.com/knoram.php?';
|
|
end;
|
|
procedure TMainForm.SetHostAddr(v: String); begin Equips.Hint := v; end;
|
|
|
|
function TMainForm.GetLogin: String; begin Result := Inventory.Hint; end;
|
|
procedure TMainForm.SetLogin(v: String); begin Inventory.Hint := v; end;
|
|
|
|
function TMainForm.GetPassword: String; begin Result := Plots.Hint; end;
|
|
procedure TMainForm.SetPassword(v: String); begin Plots.Hint := v; end;
|
|
|
|
function TMainForm.GetGuild: String; begin Result := Label1.Hint; end;
|
|
procedure TMainForm.SetGuild(v: String); begin Label1.Hint := v; end;
|
|
|
|
procedure TMainForm.Q(s: string);
|
|
begin
|
|
fQueue.Items.Add(s);
|
|
Dequeue;
|
|
end;
|
|
|
|
function TMainForm.TaskDone: Boolean;
|
|
begin
|
|
with TaskBar do
|
|
Result := Position >= Max;
|
|
end;
|
|
|
|
function Odds(chance, outof: Integer): Boolean;
|
|
begin
|
|
Result := Random(outof) < chance;
|
|
end;
|
|
|
|
function RandSign(): Integer;
|
|
begin
|
|
Result := Random(2) * 2 - 1;
|
|
end;
|
|
|
|
function Pick(s: TStrings): String;
|
|
begin
|
|
Result := s[Random(s.Count)];
|
|
end;
|
|
|
|
function RandomLow(below: Integer): Integer;
|
|
begin
|
|
Result := Min(Random(below),Random(below));
|
|
end;
|
|
|
|
function Ends(s,e: String): Boolean;
|
|
begin
|
|
Result := Copy(s,1+Length(s)-Length(e),Length(e)) = e;
|
|
end;
|
|
|
|
function Plural(s: String): String;
|
|
begin
|
|
if Ends(s,'y')
|
|
then Result := Copy(s,1,Length(s)-1) + 'ies'
|
|
else if Ends(s,'us')
|
|
then Result := Copy(s,1,Length(s)-2) + 'i'
|
|
else if Ends(s,'ch') or Ends(s,'x') or Ends(s,'s')
|
|
then Result := s + 'es'
|
|
else if Ends(s,'f')
|
|
then Result := Copy(s,1,Length(s)-1) + 'ves'
|
|
else if Ends(s,'man') or Ends(s,'Man')
|
|
then Result := Copy(s,1,Length(s)-2) + 'en'
|
|
else Result := s + 's';
|
|
end;
|
|
|
|
function Split(s: String; field: Integer): String;
|
|
var
|
|
p: Integer;
|
|
begin
|
|
while field > 0 do begin
|
|
p := Pos('|',s);
|
|
s := Copy(s,p+1,10000);
|
|
Dec(field);
|
|
end;
|
|
if Pos('|',s) > 0
|
|
then Result := Copy(s,1,Pos('|',s)-1)
|
|
else Result := s;
|
|
end;
|
|
|
|
function Indefinite(s: String; qty: Integer): String;
|
|
begin
|
|
if qty = 1 then begin
|
|
if Pos(s[1], 'AEIOUÜaeiouü') > 0
|
|
then Result := 'an ' + s
|
|
else Result := 'a ' + s;
|
|
end else begin
|
|
Result := IntToStr(qty) + ' ' + Plural(s);
|
|
end;
|
|
end;
|
|
|
|
function Definite(s: String; qty: Integer): String;
|
|
begin
|
|
if qty > 1 then
|
|
s := {IntToStr(qty) + ' ' +} Plural(s);
|
|
Result := 'the ' + s;
|
|
end;
|
|
|
|
function Sick(m: Integer; s: String): String;
|
|
begin
|
|
Result := IntToStr(m) + s; // in case I screw up
|
|
case m of
|
|
-5,5: Result := 'dead ' + s;
|
|
-4,4: Result := 'comatose ' + s;
|
|
-3,3: Result := 'crippled ' + s;
|
|
-2,2: Result := 'sick ' + s;
|
|
-1,1: Result := 'undernourished ' + s;
|
|
end;
|
|
end;
|
|
|
|
function Young(m: Integer; s: String): String;
|
|
begin
|
|
Result := IntToStr(m) + s; // in case I screw up
|
|
case -m of
|
|
-5,5: Result := 'fœtal ' + s;
|
|
-4,4: Result := 'baby ' + s;
|
|
-3,3: Result := 'preadolescent ' + s;
|
|
-2,2: Result := 'teenage ' + s;
|
|
-1,1: Result := 'underage ' + s;
|
|
end;
|
|
end;
|
|
|
|
function Big(m: Integer; s: String): String;
|
|
begin
|
|
Result := s; // in case I screw up
|
|
case m of
|
|
1,-1: Result := 'greater ' + s;
|
|
2,-2: Result := 'massive ' + s;
|
|
3,-3: Result := 'enormous ' + s;
|
|
4,-4: Result := 'giant ' + s;
|
|
5,-5: Result := 'titanic ' + s;
|
|
end;
|
|
end;
|
|
|
|
function Special(m: Integer; s: String): String;
|
|
begin
|
|
Result := s; // in case I screw up
|
|
case -m of
|
|
1,-1:
|
|
if Pos(' ',Result) > 0
|
|
then Result := 'veteran ' + s
|
|
else Result := 'Battle-' + s;
|
|
2,-2: Result := 'cursed ' + s;
|
|
3,-3:
|
|
if Pos(' ',Result) > 0
|
|
then Result := 'warrior ' + s
|
|
else Result := 'Were-' + s;
|
|
4,-4: Result := 'undead ' + s;
|
|
5,-5: Result := 'demon ' + s;
|
|
end;
|
|
end;
|
|
|
|
function TMainForm.MonsterTask(var level: Integer): String;
|
|
var
|
|
qty, lev, i: Integer;
|
|
monster, m1: string;
|
|
begin
|
|
for i := level downto 1 do begin
|
|
if Odds(2,5) then
|
|
Inc(level, RandSign());
|
|
end;
|
|
if level < 1 then level := 1;
|
|
// level = level of puissance of opponent(s) we'll return
|
|
|
|
if Odds(1,25) then begin
|
|
// use an NPC every once in a while
|
|
monster := 'passing ' + Pick(NewGuyForm.Race.Items) + ' ' + Pick(NewGuyForm.Klass.Items);
|
|
lev := level;
|
|
monster := monster + '|' + IntToStr(level) + '|*';
|
|
end else if (fQuest.Caption <> '') and Odds(1,4) then begin
|
|
// use the quest monster
|
|
monster := k.Monsters.Lines[fQuest.Tag];
|
|
lev := StrToInt(Split(monster,1));
|
|
end else begin
|
|
// pick the monster out of so many random ones closest to the level we want
|
|
monster := Pick(K.Monsters.Lines);
|
|
lev := StrToInt(Split(monster,1));
|
|
i := 5;
|
|
while (i > 0) do begin // or (lev - level > 4) do begin
|
|
m1 := Pick(K.Monsters.Lines);
|
|
if abs(level-StrToInt(Split(m1,1))) < abs(level-lev) then begin
|
|
monster := m1;
|
|
lev := StrToInt(Split(monster,1));
|
|
end;
|
|
if i > 0 then Dec(i);
|
|
end;
|
|
end;
|
|
|
|
fTask.Caption := monster;
|
|
Result := Split(monster,0);
|
|
fTask.Caption := 'kill|' + fTask.Caption;
|
|
|
|
qty := 1;
|
|
if (level-lev) > 10 then begin
|
|
// lev is too low. multiply...
|
|
qty := (level + Random(lev)) div max(lev,1);
|
|
if qty < 1 then qty := 1;
|
|
level := level div qty;
|
|
end;
|
|
|
|
if (level - lev) <= -10 then begin
|
|
Result := 'imaginary ' + Result;
|
|
end else if (level-lev) < -5 then begin
|
|
i := 10+(level-lev);
|
|
i := 5-Random(i+1);
|
|
Result := Sick(i,Young((lev-level)-i,Result));
|
|
end else if ((level-lev) < 0) and (Random(2) = 1) then begin
|
|
Result := Sick(level-lev,Result);
|
|
end else if ((level-lev) < 0) then begin
|
|
Result := Young(level-lev,Result);
|
|
end else if (level-lev) >= 10 then begin
|
|
Result := 'messianic ' + Result;
|
|
end else if (level-lev) > 5 then begin
|
|
i := 10-(level-lev);
|
|
i := 5-Random(i+1);
|
|
Result := Big(i,Special((level-lev)-i,Result));
|
|
end else if ((level-lev) > 0) and (Random(2) = 1) then begin
|
|
Result := Big(level-lev,Result);
|
|
end else if ((level-lev) > 0) then begin
|
|
Result := Special(level-lev,Result);
|
|
end;
|
|
|
|
lev := level;
|
|
level := lev * qty;
|
|
|
|
Result := Indefinite(Result, qty);
|
|
end;
|
|
|
|
function ProperCase(s:String):String;
|
|
begin
|
|
Result := UpperCase(Copy(s,1,1)) + Copy(s,2,10000);
|
|
end;
|
|
|
|
function TMainForm.EquipPrice: Integer;
|
|
begin
|
|
Result := 5 * GetI(Traits,'Level') * GetI(Traits,'Level')
|
|
+ 10 * GetI(Traits,'Level')
|
|
+ 20;
|
|
end;
|
|
|
|
procedure TMainForm.Dequeue;
|
|
var
|
|
s, a, old: String;
|
|
n, l: Integer;
|
|
begin
|
|
while TaskDone do begin
|
|
if Split(fTask.Caption,0) = 'kill' then begin
|
|
if Split(fTask.Caption,3) = '*' then begin
|
|
WinItem;
|
|
end else if Split(fTask.Caption,3) <> '' then begin
|
|
Add(Inventory,LowerCase(Split(fTask.Caption,1) + ' ' + ProperCase(Split(fTask.Caption,3))),1);
|
|
end;
|
|
end else if fTask.Caption = 'buying' then begin
|
|
// buy some equipment
|
|
Add(Inventory,'Gold',-EquipPrice);
|
|
WinEquip;
|
|
end else if (fTask.Caption = 'market') or (fTask.Caption = 'sell') then with Inventory do begin
|
|
if fTask.Caption = 'sell' then begin
|
|
Tag := GetI(Inventory,1);
|
|
Tag := Tag * GetI(Traits,'Level');
|
|
if Pos(' of ',Items[1].Caption) > 0 then
|
|
Tag := Tag * (1+RandomLow(10)) * (1+RandomLow(GetI(Traits,'Level')));
|
|
Items[0].MakeVisible(false);
|
|
Items.Delete(1);
|
|
Add(Inventory,'Gold',Tag);
|
|
end;
|
|
if Items.Count > 1 then begin
|
|
Task('Selling ' + Indefinite(Inventory.Items[1].Caption, GetI(Inventory,1)), 1 * 1000);
|
|
fTask.Caption := 'sell';
|
|
break;
|
|
end;
|
|
end;
|
|
old := fTask.Caption;
|
|
fTask.Caption := '';
|
|
if (fQueue.Items.Count > 0) then begin
|
|
a := Split(fQueue.Items[0],0);
|
|
n := StrToInt(Split(fQueue.Items[0],1));
|
|
s := Split(fQueue.Items[0],2);
|
|
if a = 'task' then begin
|
|
Task(s, n * 1000);
|
|
fQueue.Items.Delete(0);
|
|
end else begin
|
|
raise Exception.Create('bah!');
|
|
end;
|
|
end else with Encumbar do if Position >= Max then begin
|
|
Task('Heading to market to sell loot',4 * 1000);
|
|
fTask.Caption := 'market';
|
|
end else if (Pos('kill|',old) <= 0) and (old <> 'heading') then begin
|
|
if GetI(Inventory, 'Gold') > EquipPrice then begin
|
|
Task('Negotiating purchase of better equipment', 5 * 1000);
|
|
fTask.Caption := 'buying';
|
|
end else begin
|
|
Task('Heading to the killing fields', 4 * 1000);
|
|
fTask.Caption := 'heading';
|
|
end;
|
|
end else begin
|
|
n := GetI(Traits,'Level');
|
|
l := n;
|
|
s := MonsterTask(n);
|
|
n := (2 * InventoryLabelAlsoGameStyle.Tag * n * 1000) div l;
|
|
Task('Executing ' + s, n);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function IndexOf(list: TListView; key: String): Integer;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i := 0 to list.Items.Count-1 do if list.Items.Item[i].Caption = key then begin
|
|
Result := i;
|
|
Exit;
|
|
end;
|
|
with list.Items.Add do begin
|
|
Result := Index;
|
|
Caption := key;
|
|
MakeVisible(false);
|
|
list.Width := list.Width - 1; // trigger an autosize
|
|
end;
|
|
end;
|
|
|
|
procedure TMainForm.Put(list: TListView; key, value: String);
|
|
begin
|
|
Put(list, IndexOf(list,key), value);
|
|
end;
|
|
|
|
procedure TMainForm.Put(list: TListView; key: String; value: Integer);
|
|
begin
|
|
Put(list,key,IntToStr(value));
|
|
if key = 'STR' then
|
|
Encumbar.Max := 10 + value;
|
|
if list = Inventory then with Encumbar do begin
|
|
Position := Sum(Inventory) - GetI(Inventory,'Gold');
|
|
Hint := IntToStr(Position) + '/' + IntToStr(Max) + ' cubits';
|
|
end;
|
|
end;
|
|
|
|
procedure TMainForm.Put(list: TListView; pos: Integer; value: String);
|
|
begin
|
|
with list.Items.Item[pos] do begin
|
|
if SubItems.Count < 1
|
|
then SubItems.Add(value)
|
|
else SubItems[0] := value;
|
|
end;
|
|
//list.MultiSelect := true;
|
|
//list.RowSelect := true;
|
|
//list.HideSelection := false;
|
|
list.Items[pos].Selected := true;
|
|
end;
|
|
|
|
function LevelUpTime(level: Integer): Integer;
|
|
begin
|
|
// ~20 minutes for level 1, eventually dominated by exponential
|
|
Result := Round((20.0 + IntPower(1.15,level)) * 60.0);
|
|
end;
|
|
|
|
procedure TMainForm.GoButtonClick(Sender: TObject);
|
|
begin
|
|
with ExpBar do begin
|
|
Position := 0;
|
|
Max := LevelUpTime(1);
|
|
end;
|
|
|
|
fTask.Caption := '';
|
|
fQuest.Caption := '';
|
|
fQueue.Items.Clear;
|
|
|
|
Task('Loading.',2000); // that dot is spotted for later...
|
|
Q('task|10|Experiencing an enigmatic and foreboding night vision');
|
|
Q('task|6|Much is revealed about that wise old bastard you''d underestimated');
|
|
Q('task|6|A shocking series of events leaves you alone and bewildered, but resolute');
|
|
Q('task|4|Drawing upon an unexpected reserve of determination, you set out on a long and dangerous journey');
|
|
Q('task|2|Loading');
|
|
|
|
PlotBar.Max := 26;
|
|
with Plots.Items.Add do begin
|
|
Caption := 'Prologue';
|
|
StateIndex := 0;
|
|
end;
|
|
|
|
StartTimer;
|
|
SaveGame;
|
|
Brag('s');
|
|
end;
|
|
|
|
procedure TMainForm.WinSpell;
|
|
begin
|
|
AddR(Spells, K.Spells.Lines[RandomLow(Min(GetI(Stats,'WIS')+GetI(Traits,'Level'),
|
|
K.Spells.Lines.Count))], 1);
|
|
end;
|
|
|
|
function LPick(list: TStrings; goal: Integer): String;
|
|
var
|
|
i, best, b1: Integer;
|
|
s: String;
|
|
begin
|
|
Result := Pick(list);
|
|
for i := 1 to 5 do begin
|
|
best := StrToInt(Split(Result,1));
|
|
s := Pick(list);
|
|
b1 := StrToInt(Split(s,1));
|
|
if abs(goal-best) > abs(goal-b1) then
|
|
Result := s;
|
|
end;
|
|
end;
|
|
|
|
procedure TMainForm.WinEquip;
|
|
var
|
|
posn, qual, plus, count: Integer;
|
|
name, modifier: String;
|
|
stuff, better, worse: TStrings;
|
|
begin
|
|
posn := Random(Equips.Items.Count);
|
|
Equips.Tag := posn; // remember as the "best item"
|
|
if posn = 0 then begin
|
|
stuff := K.Weapons.Lines;
|
|
better := K.OffenseAttrib.Lines;
|
|
worse := K.OffenseBad.Lines;
|
|
end else begin
|
|
better := K.DefenseAttrib.Lines;
|
|
worse := K.DefenseBad.Lines;
|
|
if posn = 1
|
|
then stuff := K.Shields.Lines
|
|
else stuff := K.Armors.Lines;
|
|
end;
|
|
name := LPick(stuff,GetI(Traits,'Level'));
|
|
qual := StrToInt(Split(name,1));
|
|
name := Split(name,0);
|
|
plus := GetI(Traits,'Level') - qual;
|
|
if plus < 0 then better := worse;
|
|
count := 0;
|
|
while (count < 2) and (plus <> 0) do begin
|
|
modifier := Pick(better);
|
|
qual := StrToInt(Split(modifier, 1));
|
|
modifier := Split(modifier, 0);
|
|
if Pos(modifier, name) > 0 then Break; // no repeats
|
|
if Abs(plus) < Abs(qual) then Break; // too much
|
|
name := modifier + ' ' + name;
|
|
Dec(plus, qual);
|
|
Inc(count);
|
|
end;
|
|
if plus <> 0 then name := IntToStr(plus) + ' ' + name;
|
|
if plus > 0 then name := '+' + name;
|
|
|
|
Put(Equips, posn, name);
|
|
end;
|
|
|
|
procedure TMainForm.WinStat;
|
|
var
|
|
i,t: Integer;
|
|
function Square(x: Integer): Integer; begin Result := x * x; end;
|
|
begin
|
|
if Odds(1,2)
|
|
then i := Random(Stats.Items.Count)
|
|
else begin
|
|
// favor the best stat so it will tend to clump
|
|
t := 0;
|
|
for i := 0 to 5 do Inc(t,Square(GetI(Stats,i)));
|
|
t := Random(t);
|
|
i := -1;
|
|
while t >= 0 do begin
|
|
Inc(i);
|
|
Dec(t,Square(GetI(Stats,i)));
|
|
end;
|
|
end;
|
|
Add(Stats, Stats.Items[i].Caption, 1);
|
|
end;
|
|
|
|
function TMainForm.SpecialItem: String;
|
|
begin
|
|
Result := InterestingItem + ' of ' +
|
|
Pick(K.ItemOfs.Lines);
|
|
end;
|
|
|
|
function TMainForm.InterestingItem: String;
|
|
begin
|
|
Result := Pick(K.ItemAttrib.Lines) + ' ' +
|
|
Pick(K.Specials.Lines);
|
|
end;
|
|
|
|
function TMainForm.BoringItem: String;
|
|
begin
|
|
Result := Pick(K.BoringItems.Lines);
|
|
end;
|
|
|
|
procedure TMainForm.WinItem;
|
|
begin
|
|
Add(Inventory, SpecialItem, 1);
|
|
end;
|
|
|
|
procedure TMainForm.CompleteQuest;
|
|
var
|
|
lev, level, l, i, montag: Integer;
|
|
m: string;
|
|
begin
|
|
with QuestBar do begin
|
|
Position := 0;
|
|
Max := 50 + Random(100);
|
|
end;
|
|
with Quests do begin
|
|
if Items.Count > 0 then begin
|
|
Items[Items.Count-1].StateIndex := 1;
|
|
case Random(4) of
|
|
0: WinSpell;
|
|
1: WinEquip;
|
|
2: WinStat;
|
|
3: WinItem;
|
|
end;
|
|
end;
|
|
while Items.Count > 99 do Items.Delete(0);
|
|
|
|
with Items.Add do begin
|
|
case Random(5) of
|
|
0: begin
|
|
level := GetI(Traits,'Level');
|
|
for i := 1 to 4 do begin
|
|
montag := Random(K.Monsters.Lines.Count);
|
|
m := K.Monsters.Lines[montag];
|
|
l := StrToInt(Split(m,1));
|
|
if (i = 1) or (abs(l - level) < abs(lev - level)) then begin
|
|
lev := l;
|
|
fQuest.Caption := m;
|
|
fQuest.Tag := montag;
|
|
end;
|
|
end;
|
|
Caption := 'Exterminate ' + Definite(Split(fQuest.Caption,0),2);
|
|
end;
|
|
1: begin
|
|
fQuest.Caption := InterestingItem;
|
|
Caption := 'Seek ' + Definite(fQuest.Caption,1);
|
|
fQuest.Caption := '';
|
|
end;
|
|
2: begin
|
|
fQuest.Caption := BoringItem;
|
|
Caption := 'Deliver this ' + fQuest.Caption;
|
|
fQuest.Caption := '';
|
|
end;
|
|
3: begin
|
|
fQuest.Caption := BoringItem;
|
|
Caption := 'Fetch me ' + Indefinite(fQuest.Caption,1);
|
|
fQuest.Caption := '';
|
|
end;
|
|
4: begin
|
|
level := GetI(Traits,'Level');
|
|
for i := 1 to 2 do begin
|
|
montag := Random(K.Monsters.Lines.Count);
|
|
m := K.Monsters.Lines[montag];
|
|
l := StrToInt(Split(m,1));
|
|
if (i = 1) or (abs(l - level) < abs(lev - level)) then begin
|
|
lev := l;
|
|
fQuest.Caption := m;
|
|
end;
|
|
end;
|
|
Caption := 'Placate ' + Definite(Split(fQuest.Caption,0),2);
|
|
fQuest.Caption := '';
|
|
end;
|
|
end;
|
|
StateIndex := 0;
|
|
MakeVisible(false);
|
|
end;
|
|
Width := Width - 1; // trigger a column resize
|
|
end;
|
|
SaveGame;
|
|
end;
|
|
|
|
function Rome(var n: Integer; dn: Integer; var s: String; ds: String): Boolean;
|
|
begin
|
|
Result := (n >= dn);
|
|
if Result then begin
|
|
n := n - dn;
|
|
s := s + ds;
|
|
end;
|
|
end;
|
|
|
|
function UnRome(var s: String; dn: Integer; var n: Integer; ds: String): Boolean;
|
|
begin
|
|
Result := (Copy(s,1,Length(ds)) = ds);
|
|
if Result then begin
|
|
s := Copy(s,Length(ds)+1,10000);
|
|
n := n + dn;
|
|
end;
|
|
end;
|
|
|
|
function IntToRoman(n: Integer): String;
|
|
begin
|
|
while Rome(n, 1000, Result, 'M') do ;
|
|
Rome(n, 900, Result, 'CM');
|
|
Rome(n, 500, Result, 'D');
|
|
Rome(n, 400, Result, 'CD');
|
|
while Rome(n, 100, Result, 'C') do ;
|
|
Rome(n, 90, Result, 'XC');
|
|
Rome(n, 50, Result, 'L');
|
|
Rome(n, 40, Result, 'XL');
|
|
while Rome(n, 10, Result, 'X') do ;
|
|
Rome(n, 9, Result, 'IX');
|
|
Rome(n, 5, Result, 'V');
|
|
Rome(n, 4, Result, 'IV');
|
|
while Rome(n, 1, Result, 'I') do ;
|
|
end;
|
|
|
|
function RomanToInt(n: String): Integer;
|
|
begin
|
|
Result := 0;
|
|
while UnRome(n, 1000, Result, 'M') do ;
|
|
UnRome(n, 900, Result, 'CM');
|
|
UnRome(n, 500, Result, 'D');
|
|
UnRome(n, 400, Result, 'CD');
|
|
while UnRome(n, 100, Result, 'C') do ;
|
|
UnRome(n, 90, Result, 'XC');
|
|
UnRome(n, 50, Result, 'L');
|
|
UnRome(n, 40, Result, 'XL');
|
|
while UnRome(n, 10, Result, 'X') do ;
|
|
UnRome(n, 9, Result, 'IX');
|
|
UnRome(n, 5, Result, 'V');
|
|
UnRome(n, 4, Result, 'IV');
|
|
while UnRome(n, 1, Result, 'I') do ;
|
|
end;
|
|
|
|
procedure TMainForm.CompleteAct;
|
|
begin
|
|
PlotBar.Position := 0;
|
|
with Plots do begin
|
|
Items[Items.Count-1].StateIndex := 1;
|
|
PlotBar.Max := 60 * 60 * (1 + 5 * Items.Count); // 1 hr + 5/act
|
|
PlotBar.Hint := 'Cutscene omitted';
|
|
with Items.Add do begin
|
|
Caption := 'Act ' + IntToRoman(Items.Count-1);
|
|
MakeVisible(false);
|
|
StateIndex := 0;
|
|
Width := Width-1;
|
|
end;
|
|
end;
|
|
SaveGame;
|
|
Brag('a');
|
|
end;
|
|
|
|
procedure TMainForm.Task(caption: String; msec: Integer);
|
|
begin
|
|
Kill.SimpleText := caption + '...';
|
|
with TaskBar do begin
|
|
Position := 0;
|
|
Max := msec;
|
|
end;
|
|
end;
|
|
|
|
procedure TMainForm.Add(list: TListView; key: String; value: Integer);
|
|
begin
|
|
Put(list, key, value + GetI(list,key));
|
|
end;
|
|
|
|
procedure TMainForm.AddR(list: TListView; key: String; value: Integer);
|
|
begin
|
|
Put(list, key, IntToRoman(value + RomanToInt(Get(list,key))));
|
|
end;
|
|
|
|
function TMainForm.Get(list: TListView; key: String): String;
|
|
begin
|
|
Result := Get(list, IndexOf(list,key));
|
|
end;
|
|
|
|
function TMainForm.Get(list: TListView; index: Integer): String;
|
|
begin
|
|
with list.Items.Item[index] do begin
|
|
if SubItems.Count < 1
|
|
then Result := ''
|
|
else Result := SubItems[0];
|
|
end;
|
|
end;
|
|
|
|
function TMainForm.GetI(list: TListView; key: String): Integer;
|
|
begin
|
|
Result := StrToIntDef(Get(list,key),0);
|
|
end;
|
|
|
|
function TMainForm.GetI(list: TListView; index: Integer): Integer;
|
|
begin
|
|
Result := StrToIntDef(Get(list,index),0);
|
|
end;
|
|
|
|
function TMainForm.Sum(list: TListView): Integer;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result := 0;
|
|
for i := 0 to list.Items.Count - 1 do
|
|
Inc(Result, GetI(list,i));
|
|
end;
|
|
|
|
procedure PutLast(list: TListView; value: String);
|
|
begin
|
|
if list.Items.Count > 0 then
|
|
with list.Items.Item[list.Items.Count-1] do begin
|
|
if SubItems.Count < 1
|
|
then SubItems.Add(value)
|
|
else SubItems[0] := value;
|
|
end;
|
|
list.Width := list.Width - 1; // trigger an autosize
|
|
end;
|
|
|
|
procedure TMainForm.LevelUp;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Add(Traits,'Level',1);
|
|
Add(Stats,'HP Max', GetI(Stats,'CON') div 3 + 1 + Random(4));
|
|
Add(Stats,'MP Max', GetI(Stats,'INT') div 3 + 1 + Random(4));
|
|
for i := 1 to 2 do WinStat;
|
|
WinSpell;
|
|
with ExpBar do begin
|
|
Position := 0;
|
|
Max := LevelUpTime(GetI(Traits,'Level'));
|
|
end;
|
|
SaveGame;
|
|
Brag('l');
|
|
end;
|
|
|
|
procedure TMainForm.ClearAllSelections;
|
|
begin
|
|
Equips.ClearSelection;
|
|
Spells.ClearSelection;
|
|
Stats.ClearSelection;
|
|
Traits.ClearSelection;
|
|
Inventory.ClearSelection;
|
|
Plots.ClearSelection;
|
|
Quests.ClearSelection;
|
|
end;
|
|
|
|
function RoughTime(s: Integer): String;
|
|
begin
|
|
if s < 120 then Result := IntToStr(s) + ' seconds'
|
|
else if s < 60 * 120 then Result := IntToStr(s div 60) + ' minutes'
|
|
else if s < 60 * 60 * 48 then Result := IntToStr(s div 3600) + ' hours'
|
|
else Result := IntToStr(s div (3600 * 24)) + ' days';
|
|
end;
|
|
|
|
procedure TMainForm.Timer1Timer(Sender: TObject);
|
|
var
|
|
gain: Boolean;
|
|
elapsed: Integer;
|
|
begin
|
|
gain := Pos('kill|',fTask.Caption) = 1;
|
|
with TaskBar do begin
|
|
if Position >= Max then begin
|
|
ClearAllSelections;
|
|
|
|
if Kill.SimpleText = 'Loading....' then Max := 0;
|
|
|
|
if gain then with ExpBar do if Position >= Max
|
|
then LevelUp
|
|
else Position := Position + TaskBar.Max div 1000;
|
|
with ExpBar do Hint := IntToStr(Max-Position) + ' XP needed for next level';
|
|
|
|
if gain then if Plots.Items.Count > 1 then with QuestBar do if Position >= Max then begin
|
|
CompleteQuest;
|
|
end else if Quests.Items.Count > 0 then begin
|
|
Position := Position + TaskBar.Max div 1000;
|
|
Hint := IntToStr(100 * Position div Max) + '% complete';
|
|
end;
|
|
|
|
with PlotBar do if Position >= Max
|
|
then CompleteAct
|
|
else Position := Position + TaskBar.Max div 1000;
|
|
|
|
//Time.Caption := FormatDateTime('h:mm:ss',PlotBar.Position / (24.0 * 60 * 60));
|
|
PlotBar.Hint := RoughTime(PlotBar.Max-PlotBar.Position) + ' remaining';
|
|
//PlotBar.Hint := FormatDateTime('h:mm:ss" remaining"',(PlotBar.Max-PlotBar.Position) / (24.0 * 60 * 60));
|
|
|
|
Dequeue();
|
|
end else with TaskBar do begin
|
|
elapsed := timeGetTime - Timer1.Tag;
|
|
if elapsed > 100 then elapsed := 100;
|
|
if elapsed < 0 then elapsed := 0;
|
|
Position := Position + elapsed;//Integer(Timer1.Interval);
|
|
end;
|
|
end;
|
|
Timer1.Tag := timeGetTime;
|
|
end;
|
|
|
|
procedure TMainForm.FormCreate(Sender: TObject);
|
|
begin
|
|
QuestBar.Position := 0;
|
|
PlotBar.Position := 0;
|
|
TaskBar.Position := 0;
|
|
ExpBar.Position := 0;
|
|
Encumbar.Position := 0;
|
|
end;
|
|
|
|
procedure TMainForm.SpeedButton1Click(Sender: TObject);
|
|
begin
|
|
{$IFDEF CHEATS}
|
|
TaskBar.Position := TaskBar.Max;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TMainForm.RollCharacter: Boolean;
|
|
var
|
|
f: Integer;
|
|
begin
|
|
Result := true;
|
|
repeat
|
|
if not NewGuyForm.Go then begin
|
|
Result := false;
|
|
Exit;
|
|
end;
|
|
Put(Traits, 'Name', NewGuyForm.Name.Text);
|
|
if FileExists(GameSaveName) and
|
|
(mrNo = MessageDlg('The saved game "' + GameSaveName + '" already exists. Do you want to overwrite it?', mtWarning, [mbYes,mbNo], 0)) then begin
|
|
// go around again
|
|
end else begin
|
|
f := FileCreate(GameSaveName);
|
|
if f = -1 then begin
|
|
ShowMessage('The thought police don''t like the name "' + GameSaveName + '". Choose a name without \\ / : * ? " < > or | in it.');
|
|
end else begin
|
|
FileClose(f);
|
|
Break;
|
|
end;
|
|
end;
|
|
until false;
|
|
|
|
with NewGuyForm do begin
|
|
Put(Traits,'Name',Name.Text);
|
|
Put(Traits,'Race',Race.Items[Race.ItemIndex]);
|
|
Put(Traits,'Class',Klass.Items[Klass.ItemIndex]);
|
|
Put(Traits,'Level',1);
|
|
Put(Stats,'STR',STR.Tag);
|
|
Put(Stats,'CON',CON.Tag);
|
|
Put(Stats,'DEX',DEX.Tag);
|
|
Put(Stats,'INT',INT.Tag);
|
|
Put(Stats,'WIS',WIS.Tag);
|
|
Put(Stats,'CHA',CHA.Tag);
|
|
Put(Stats,'HP Max',Random(8) + CON.Tag div 6);
|
|
Put(Stats,'MP Max',Random(8) + INT.Tag div 6);
|
|
Put(Equips,'Weapon','Sharp Stick');
|
|
Put(Inventory,'Gold',0);
|
|
InventoryLabelAlsoGameStyle.Tag := 3;//GameStyle.Position;
|
|
ClearAllSelections;
|
|
GoButtonClick(NewGuyForm);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TMainForm.FormShow(Sender: TObject);
|
|
var
|
|
Done: Boolean;
|
|
begin
|
|
if Timer1.Enabled then Exit;
|
|
Done := false;
|
|
if ParamCount >= 1 then begin
|
|
LoadGame(ParamStr(1));
|
|
NewGuyForm.Server.OnSuccess := nil;
|
|
NewGuyForm.Server.OnFailure := nil;
|
|
end else
|
|
while not Done do begin
|
|
SetHostName('');
|
|
SetHostAddr('');
|
|
SetLogin('');
|
|
SetPassword('');
|
|
case FrontForm.ShowModal of
|
|
mrOk: begin
|
|
Done := RollCharacter;
|
|
end;
|
|
mrRetry: begin
|
|
// load
|
|
if FrontForm.OpenDialog1.Execute then begin
|
|
LoadGame(FrontForm.OpenDialog1.Filename);
|
|
NewGuyForm.Server.OnSuccess := nil;
|
|
NewGuyForm.Server.OnFailure := nil;
|
|
Done := true;
|
|
end;
|
|
end;
|
|
mrYesToAll: begin
|
|
Done := ServerSelectForm.Go;
|
|
end;
|
|
mrCancel: begin
|
|
Close;
|
|
Done := true;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TMainForm.Button1Click(Sender: TObject);
|
|
begin
|
|
{$IFDEF CHEATS}
|
|
LevelUp;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TMainForm.CashInClick(Sender: TObject);
|
|
begin
|
|
{$IFDEF CHEATS}
|
|
WinEquip;
|
|
WinItem;
|
|
WinSpell;
|
|
WinStat;
|
|
Add(Inventory,'Gold',Random(100));
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TMainForm.FinishQuestClick(Sender: TObject);
|
|
begin
|
|
{$IFDEF CHEATS}
|
|
QuestBar.Position := QuestBar.Max;
|
|
TaskBar.Position := TaskBar.Max;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TMainForm.CheatPlotClick(Sender: TObject);
|
|
begin
|
|
{$IFDEF CHEATS}
|
|
PlotBar.Position := PlotBar.Max;
|
|
TaskBar.Position := TaskBar.Max;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TMainForm.SaveGame: Boolean;
|
|
var
|
|
f: TFileStream;
|
|
m: TMemoryStream;
|
|
i: Integer;
|
|
begin
|
|
Result := true;
|
|
try
|
|
DeleteFile(GameSaveName + '.bak');
|
|
MoveFile(PChar(GameSaveName), PChar(GameSaveName + '.bak'));
|
|
f := TFileStream.Create(GameSaveName, fmCreate);
|
|
except
|
|
on EfCreateError do begin
|
|
Result := false;
|
|
Exit;
|
|
end;
|
|
end;
|
|
|
|
//ClearAllSelections;
|
|
m := TMemoryStream.Create;
|
|
for i := 0 to ComponentCount-1 do
|
|
m.WriteComponent(Components[i]);
|
|
|
|
m.Seek(0, soFromBeginning);
|
|
ZCompressStream(m, f);
|
|
|
|
m.Free;
|
|
f.Free;
|
|
end;
|
|
|
|
procedure TMainForm.LoadGame(name: String);
|
|
var
|
|
f: TStream;
|
|
m: TStream;
|
|
i: Integer;
|
|
begin
|
|
m := TMemoryStream.Create;
|
|
f := TFileStream.Create(name, fmOpenRead);
|
|
try
|
|
ZDecompressStream(f, m);
|
|
f.Free;
|
|
except
|
|
on EZCompressionError do begin
|
|
// backwards-compatibility
|
|
//m.Free;
|
|
//m := f;
|
|
//f := nil;
|
|
ShowMessage('Error loading game.');
|
|
Close;
|
|
Exit;
|
|
end;
|
|
end;
|
|
Traits.Items.Clear;
|
|
Stats.Items.Clear;
|
|
Equips.Items.Clear;
|
|
m.Seek(0, soFromBeginning);
|
|
for i := 0 to ComponentCount-1 do
|
|
m.ReadComponent(Components[i]);
|
|
m.Free;
|
|
StartTimer;
|
|
TriggerAutosizes;
|
|
end;
|
|
|
|
procedure TMainForm.TriggerAutosizes;
|
|
begin
|
|
Plots.Width := 100;
|
|
Quests.Width := 100;
|
|
Inventory.Width := 100;
|
|
Equips.Width := 100;
|
|
Spells.Width := 100;
|
|
Traits.Width := 100;
|
|
Stats.Width := 100;
|
|
end;
|
|
|
|
procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
|
|
begin
|
|
if Timer1.Enabled then begin
|
|
Timer1.Enabled := false;
|
|
Shell_NotifyIcon(NIM_DELETE, @FTrayIcon);
|
|
if SaveGame then
|
|
ShowMessage('Game saved as ' + GameSaveName);
|
|
end;
|
|
end;
|
|
|
|
function TMainForm.GameSaveName: String;
|
|
begin
|
|
Result := Get(Traits,'Name');
|
|
if GetHostName <> '' then Result := Result + ' [' + GetHostName + ']';
|
|
Result := Result + '.pq';
|
|
end;
|
|
|
|
procedure TMainForm.FormKeyDown(Sender: TObject; var Key: Word;
|
|
Shift: TShiftState);
|
|
begin
|
|
if (FindWindow('TAppBuilder', nil) > 0) and (ssCtrl in Shift) and (ssShift in Shift) and (Key = ord('C')) then begin
|
|
{$IFDEF CHEATS}
|
|
Cheats.Visible := not Cheats.Visible;
|
|
{$ENDIF}
|
|
end;
|
|
if GetPasskey = 0 then Exit; // no need for these things
|
|
if (ssCtrl in Shift) and (Key = ord('B')) then begin
|
|
Brag('b');
|
|
Navigate(GetHostAddr + 'name=' + UrlEncode(Get(Traits,'Name')));
|
|
end;
|
|
if (ssCtrl in Shift) and (Key = ord('M')) then begin
|
|
SetMotto(InputBox('Progress Quest', 'Declare your motto!', GetMotto));
|
|
Brag('m');
|
|
Navigate(GetHostAddr + 'name=' + UrlEncode(Get(Traits,'Name')));
|
|
end;
|
|
if (ssCtrl in Shift) and (Key = ord('G')) then begin
|
|
SetGuild(InputBox('Progress Quest', 'Choose a guild.'#13#13'Make sure you undestand the guild rules before you join one. To learn more about guilds, visit http://progressquest.com/guilds.php', GetGuild));
|
|
Guildify;
|
|
end;
|
|
end;
|
|
|
|
procedure Navigate(url: String);
|
|
begin
|
|
ShellExecute(GetDesktopWindow(), 'open', PChar(url),
|
|
nil, '', SW_SHOW);
|
|
end;
|
|
|
|
function LFSR(pt: String; salt: Integer): Integer;
|
|
var
|
|
k: Integer;
|
|
begin
|
|
Result := salt;
|
|
for k := 1 to Length(pt) do
|
|
Result := Ord(pt[k])
|
|
xor (Result shl 1)
|
|
xor (1 and ((Result shr 31) xor (Result shr 5)));
|
|
for k := 1 to 10 do
|
|
Result := (Result shl 1)
|
|
xor (1 and ((Result shr 31) xor (Result shr 5)));
|
|
end;
|
|
|
|
|
|
procedure TMainForm.Brag(trigger: String);
|
|
var
|
|
url: string;
|
|
best, i: Integer;
|
|
const
|
|
flat = 1;
|
|
begin
|
|
if GetPasskey = 0 then Exit; // not a online game!
|
|
url := 'cmd=b&t=' + trigger;
|
|
with Traits do for i := 0 to Items.Count-1 do
|
|
url := url + '&' + LowerCase(Items[i].Caption[1]) + '=' + UrlEncode(Items[i].Subitems[0]);
|
|
url := url + '&x=' + IntToStr(ExpBar.Position);
|
|
url := url + '&i=' + UrlEncode(Get(Equips,Equips.Tag));
|
|
if Equips.Tag > 1 then url := url + '+' + Equips.Items[Equips.Tag].Caption;
|
|
best := 0;
|
|
if Spells.Items.Count > 0 then with Spells do begin
|
|
for i := 1 to Items.Count-1 do
|
|
if (i+flat) * RomanToInt(Get(Spells,i)) >
|
|
(best+flat) * RomanToInt(Get(Spells,best)) then
|
|
best := i;
|
|
url := url + '&z=' + UrlEncode(Items[best].Caption + ' ' + Get(Spells,best));
|
|
end;
|
|
best := 0;
|
|
for i := 1 to 5 do
|
|
if GetI(Stats,i) > GetI(Stats,best) then best := i;
|
|
url := url + '&k=' + Stats.Items[best].Caption + '+' + Get(Stats,best);
|
|
url := url + '&a=' + UrlEncode(Plots.Items[Plots.Items.Count-1].Caption);
|
|
url := url + '&h=' + UrlEncode(GetHostName);
|
|
url := url + RevString;
|
|
//url := url + '&passkey=' + IntToStr((not GetI(Traits,'Level') * 9831) xor GetPasskey);
|
|
url := url + '&p=' + IntToStr(LFSR(url, GetPasskey));
|
|
url := url + '&m=' + UrlEncode(GetMotto);
|
|
with NewGuyForm.Server do try
|
|
Abort;
|
|
HeaderInfo.UserId := GetLogin;
|
|
HeaderInfo.Password := GetPassword;
|
|
OnSuccess := NewGuyForm.BragSuccess;
|
|
Get(GetHostAddr + url);
|
|
except
|
|
on ESockError do begin
|
|
// 'ats okay.
|
|
Abort;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TMainForm.Guildify;
|
|
var
|
|
url: string;
|
|
i: Integer;
|
|
begin
|
|
if GetPasskey = 0 then Exit; // not a online game!
|
|
url := 'cmd=guild';
|
|
with Traits do for i := 0 to Items.Count-1 do
|
|
url := url + '&' + LowerCase(Items[i].Caption[1]) + '=' + UrlEncode(Items[i].Subitems[0]);
|
|
url := url + '&h=' + UrlEncode(GetHostName);
|
|
url := url + RevString;
|
|
url := url + '&guild=' + UrlEncode(GetGuild);
|
|
url := url + '&p=' + IntToStr(LFSR(url, GetPasskey));
|
|
with NewGuyForm.GuildGet do try
|
|
Abort;
|
|
HeaderInfo.UserId := GetLogin;
|
|
HeaderInfo.Password := GetPassword;
|
|
Get(GetHostAddr + url);
|
|
except
|
|
on ESockError do begin
|
|
// 'ats okay.
|
|
Abort;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
initialization
|
|
RegisterClasses([TMainForm]);
|
|
end.
|
|
|
|
|
|
|