PC Online 1998 September/PCO_0998.ISO/filesbbs/win95/wpchessb.exe/Source/MainForm.pas

Pascal/Delphi Source File | 1998-06-13 | 20.0 KB | 627 lines

unit MainForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ChessBrd, StdCtrls, WinpointAPI, WPAPICommon, ExtCtrls, Menus, FidoAddr,
  ComCtrls;

type
  TForm1 = class(TForm)
    WinPointAPI: TWinPointAPI;
    Serv_NewGame: TAreaService;
    MainMenu1: TMainMenu;
    Datei1: TMenuItem;
    Bevel3: TBevel;
    Serv_NewMove: TMsgService;
    Schlieen1: TMenuItem;
    Hilfe1: TMenuItem;
    Info1: TMenuItem;
    Panel1: TPanel;
    Panel2: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Container: TPanel;
    SenderName: TEdit;
    SenderAddr: TEdit;
    ReceiverName: TEdit;
    ReceiverAddr: TEdit;
    Subject: TEdit;
    Panel4: TPanel;
    Ok: TButton;
    Cancel: TButton;
    Undo: TButton;
    Panel5: TPanel;
    Panel6: TPanel;
    ChessBoard: TChessBrd;
    Bevel2: TBevel;
    StatusBar1: TStatusBar;
    Bevel1: TBevel;
    Panel7: TPanel;
    Panel8: TPanel;
    Memo: TMemo;
    Panel9: TPanel;
    Panel10: TPanel;
    Moves: TListBox;
    procedure ChessBoardLegalMove(Sender: TObject; oldSq, newSq: Square);
    procedure UndoClick(Sender: TObject);
    procedure ChessBoardMate(Sender: TObject; oldSq, newSq: Square);
    procedure ChessBoardDraw(Sender: TObject);
    procedure WinPointAPIServerDisconnected(Sender: TObject);
    procedure WinPointAPIConnectFailed(Sender: TObject);
    procedure Serv_NewGameCommand(Areas: TStringList; Msg: TMsg);
    procedure ChessBoardCheck(Sender: TObject; oldSq, newSq: Square);
    procedure OkClick(Sender: TObject);
    procedure CancelClick(Sender: TObject);
    procedure Serv_NewMoveCommand(Msgs: TList; Msg: TMsg);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Schlieen1Click(Sender: TObject);
    procedure FormHide(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Info1Click(Sender: TObject);
    procedure WinPointAPIWrongVersion(Sender: TObject);
    procedure ContainerResize(Sender: TObject);
  protected
  private
    { Private-Deklarationen }
    AT        :Integer;
    DestArea  :String;
    Reply     :String;
    eMail     :String;
    Rebuilding:Boolean;
    WasCheck  :Boolean;
    WasMate   :Boolean;
    WasRemis  :Boolean;
    procedure ResetBoard;
    procedure SetupAddressMode;
    procedure UpdateMoves;
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

uses AboutForm;

{$R *.DFM}

procedure TForm1.UpdateMoves;
var
  Temp:TSTringList;
begin
     Temp :=TSTringList.Create;
     ChessBoard.GetMoveList(Temp);
     Moves.Items :=Temp;
     Temp.Destroy;
end;

procedure TForm1.ChessBoardLegalMove(Sender: TObject; oldSq, newSq: Square);
begin
     if not Rebuilding then
     begin
          ChessBoard.Enabled :=False;
          Undo.Enabled       :=True;
          Ok.Enabled         :=True;
          UpdateMoves;
     end;
end;

procedure TForm1.UndoClick(Sender: TObject);
begin
     ChessBoard.MoveBackward;
     Undo.Enabled       :=False;
     Ok.Enabled         :=False;
     Chessboard.Enabled :=True;
     UpdateMoves;
end;

procedure TForm1.ChessBoardMate(Sender: TObject; oldSq, newSq: Square);
begin
     WasMate:=True;
     if not Rebuilding then ShowMessage('Matt!');
end;

procedure TForm1.ChessBoardDraw(Sender: TObject);
begin
     WasRemis:=True;
     if not Rebuilding then ShowMessage('Remis!');
end;

procedure TForm1.WinPointAPIServerDisconnected(Sender: TObject);
begin
     Application.Terminate;
end;

procedure TForm1.WinPointAPIConnectFailed(Sender: TObject);
begin
     Application.Terminate;
end;

procedure TForm1.ResetBoard;
begin
     with Chessboard do
     begin
          ComputerPlaysBlack :=False;
          ComputerPlaysWhite :=False;
          Enabled            :=True;
          NewGame;
          CancelThinking;
     end;
     Undo.Enabled       :=False;
     Ok.Enabled         :=False;
end;

procedure TForm1.ChessBoardCheck(Sender: TObject; oldSq, newSq: Square);
begin
     WasCheck:=True;
     if not Rebuilding then ShowMessage('Schach');
end;

procedure TForm1.OkClick(Sender: TObject);
var
  Newmail :PNewMail;
  NewSize :Integer;
  i,j     :Integer;
  Lines   :String;
  Temp    :String;
  Moves   :TStringList;
  function XLat(C:Char):Char;
  begin
       case C of
       'r':Result:='t';
       'n':Result:='s';
       'b':Result:='l';
       'p':Result:='b';
       'q':Result:='d';
       'R':Result:='T';
       'N':Result:='S';
       'B':Result:='L';
       'P':Result:='B';
       'Q':Result:='D';
       #0 :Result:=' ';
       else Result:=C;
       end;
  end;
begin
     Moves :=TStringList.Create;
     // use new email if entered and interesting
     if (AT in [AT_NET,AT_EMAIL]) and (Pos('@',SenderName.Text)>0) then
     begin
          email           :=SenderName.Text;
          SenderName.Text :='UUCP';
     end;
     // Text
     Lines   :=#1'WPPLUGINCMD <WPChess> 2049'+#$0d+#$0a+
               'WPC> WinPoint Schach Partie zur automatischen Verarbeitung '+
               'durch das WinPoint 95 Schach Plugin. '+
               'WPC> Hinweise zur manuellen Bearbeitung befinden sich am Ende '+
               'dieser Mail!'#$0d#$0a+
               #$0d#$0a+
               'Zuege: '+#$0d+#$0a+
               '==================='+#$0d+#$0a;
     if (AT in [AT_NET,AT_EMAIL]) and (email<>'')
     then Lines:='to: '+email+#$0d#$0a#$0d#$0a+Lines;
     if Reply<>'' then Lines:=#1'REPLY: '+Reply+#$0d+#$0a+Lines;
     ChessBoard.GetMoveList(Moves);
     for i:=1 to Moves.Count do Lines:=Lines+Moves[i-1]+#$0d+#$0a;
     Lines:=Lines+'==================='+#$0d#$0a#$0d#$0a;
     // Show Board
     Temp  :=ChessBoard.Position;
     Lines :=Lines+'   A B C D E F G H '#$0d#$0a;
     Lines :=Lines+'  +-+-+-+-+-+-+-+-+'#$0d#$0a;
     for i:=0 to 7 do
     begin
          Lines :=Lines+IntToStr(i+1)+' |';
          for j:=0 to 7 do Lines:=Lines+XLat(Temp[i*8+j+1])+'|';
          Lines :=Lines+#$0d#$0a;
          Lines :=Lines+'  +-+-+-+-+-+-+-+-+'#$0d#$0a;
     end;
     // Show Leged
     Lines :=Lines+#$0d#$0a+
                   'Farben:'#$0d#$0a+
                   '======='#$0d#$0a+
                   '  Weiss   Grossbuchstaben'#$0d#$0a+
                   '  Schwarz Kleinbuchstaben'#$0d#$0a+
                   #$0d#$0a+
                   'Figuren:'#$0d#$0a+
                   '========'#$0d#$0a+
                   '  B Bauer'#$0d#$0a+
                   '  L LΣufer'#$0d#$0a+
                   '  S Springer'#$0d#$0a+
                   '  T Turm'#$0d#$0a+
                   '  D Dame'#$0d#$0a+
                   '  K K÷nig'#$0d#$0a;
     // Add note for foe program users
     Lines :=Lines+#$0d#$0a+
                   'Antworten ohne WinPoint 95 Schach Plugin:'#$0d#$0a+
                   '========================================='#$0d#$0a+
                   'Um ohne Verwendung des WinPoint 95 Schach Plugins auf '+
                   'diesen Schachzug zu antworten tragen Sie bitte den neuen '+
                   'Zug oben in der Liste der Zuege ein. Nur so kann das '+
                   'WinPoint 95 Schach Plugin den neuen Zug korrekt auswerten!';
     // Add Custom text
     with Memo.Lines do
     if Count>0 then
     begin
          Lines :=Lines+#$0d#$0a#+
                  'Bemerkungen:'+#$0d#$0a+
                  '============'+#$0d#$0a;
          for i:=0 to Count-1 do Lines:=Lines+Strings[i]+#$0d+#$0a;
     end;
     // Get SIze
     NewSize :=SizeOf(TNewMail)+Length(Lines)+1;
     // Get clear buffer
     GetMem(NewMail,NewSize);
     FillChar(NewMail^,NewSize,0);
     // fill header
     with NewMail^ do
     begin
          TFidonetAddress.StrToAddr(SenderAddr.Text,OrigAddress);
          TFidonetAddress.StrToAddr(ReceiverAddr.Text,DestAddress);
          OrigName    :=SenderName.Text;
          DestName    :=ReceiverName.Text;
          Subject     :=Self.Subject.Text;
          Origin      :='Winpoint Schach Plugin';
          Flags       :=MFLG_SEND or MFLG_Created;
          Size        :=NewSize;
     end;
     // Add Lines to header
     Move(Lines[1],Pointer(Integer(NewMail)+SizeOf(TNewMail))^,Length(Lines)+1);
     WinPointAPI.OpenArea(DestArea);
     WinPointAPI.StoreMsg(NewMail);
     WinPointAPI.CloseArea;
     // Free resources
     FreeMem(NewMail);
     Moves.Destroy;
     Hide;
end;

procedure TForm1.CancelClick(Sender: TObject);
begin
     Hide;
end;

procedure TForm1.SetupAddressMode;
// Determine requiered addressing
var
  AT :Integer;
begin
     AT       :=WinPointAPI.GetAreaType(DestArea);
     Caption  :='WinPoint Schach - Partie in '+DestArea;
     // Get Addresses
     ReceiverAddr.Visible :=AT=AT_NET;
     SenderAddr.Visible   :=AT in [AT_NET, AT_ECHO];
     ContainerResize(Self);
end;

procedure TForm1.Serv_NewGameCommand(Areas: TStringList; Msg: TMsg);
var
  Link  :TNetLinkInfo;
  Links :TNetLinkList;
begin
     Memo.Lines.Clear;
     // No Reply Kludge!
     Reply    :='';
     // No eMail address found yet
     eMail    :='';
     // Reset Chessboard
     ResetBoard;
     DestArea :=Areas[0];
     AT       :=WinPointAPI.GetAreaType(DestArea);
     Caption  :='WinPoint Schach - Partie in '+DestArea;
     SetupAddressMode;
     // Get Addresses
     ReceiverName.Text    :='';
     ReceiverAddr.Text    :='';
     SenderName.Text      :='';
     SenderAddr.Text      :='';
     Subject.Text         :='Schach Partie vom '+DateTimeToStr(Now);
     case AT of
     AT_ECHO:
       begin
            WinPointAPI.GetAreaUplink(DestArea,Link);
            ReceiverName.Text    :='Alle';
            SenderName.Text      :=Link.SysopName;
            SenderAddr.Text      :=TFidonetAddress.AddrToStr(Link.SysopAddress);
       end;
     AT_NET:
       begin
            // Use default Netlink for Netmail
            ReceiverAddr.Visible :=True;
            Links                :=TNetLinkList.Create;
            WinPointAPI.GetUplinks(Links);
            if Links.Count>0 then
            begin
                 Link:=Links[0]^;
                 ReceiverName.Text :='';
                 SenderName.Text   :=Link.SysopName;
                 SenderAddr.Text   :=TFidonetAddress.AddrToStr(Link.SysopAddress);
            end;
            Links.Destroy;
       end;
     end;
     // Display window
     Show;
     SetForegroundWindow(Handle);
end;

const
  BrdSquare:array[0..7,0..7]of Square =((A1,B1,C1,D1,E1,F1,G1,H1),
                                        (A2,B2,C2,D2,E2,F2,G2,H2),
                                        (A3,B3,C3,D3,E3,F3,G3,H3),
                                        (A4,B4,C4,D4,E4,F4,G4,H4),
                                        (A5,B5,C5,D5,E5,F5,G5,H5),
                                        (A6,B6,C6,D6,E6,F6,G6,H6),
                                        (A7,B7,C7,D7,E7,F7,G7,H7),
                                        (A8,B8,C8,D8,E8,F8,G8,H8));

procedure TForm1.Serv_NewMoveCommand(Msgs: TList; Msg: TMsg);
var
  MsgList :TMessagelist;
  TheMsg  :PPakdMessage;
  Idx     :Integer;
  Link    :TNetLinkInfo;
  Links   :TNetLinkList;
  Line    :String;
  Data    :PChar;
  i,p     :Integer;
  BestM   :Integer;
  BestL   :Integer;
  MatchL  :Integer;
  Found   :Boolean;
  function GetLine(var Dest:String):String;
  var
    P    :Integer;
  begin
       P    :=Pos(#$0d,Data);
       if P>0 then
       begin
            Data[p-1] :=#0;
            Dest      :=Data;
            Inc(Integer(Data),Length(Dest)+1);
       end else
       begin
            Dest :=Data;
            Inc(Integer(Data),Length(Dest));
       end;
       Result:=Dest;
  end;
begin
     memo.Lines.Clear;
     Undo.Enabled       :=False;
     Ok.Enabled         :=False;
     Reply :='';
     email :='';
     with WinPointAPI do
     begin
          DestArea :=GetCurrentArea;
          // Reset Chessboard
          ResetBoard;
          SetupAddressMode;
          // Get Mail Header
          MsgList  :=TMessagelist.Create;
          Idx      :=Integer(Msgs[0]);
          AT       :=GetAreaType(DestArea);
          GetMsgList(MsgList);
          // Load Mail
          GetMsg(Idx,TheMsg);
          // Fix destination area if necessary
          if AT=AT_INTERNAL then
          begin
               // try to find original Area for mail
               Data  :=Pointer(TheMsg);
               Found :=False;
               Inc(Integer(Data),SizeOf(TPakdMessage));
               Inc(Integer(Data),Length(Data)+1);
               Inc(Integer(Data),Length(Data)+1);
               Inc(Integer(Data),Length(Data)+1);
               repeat
                     GetLine(Line);
                     if Copy(Line,1,5)='AREA:' then
                     begin
                          Found :=True;
                          Delete(Line,1,5);
                          DestArea :=Line;
                          AT       :=GetAreaType(DestArea);
                     end;
               until (Data[0]=#0) or Found;
          end;
          with MsgList[Idx]^ do
          with MessageInfo do
          begin
               // Set Origin
               case AT of
               AT_ECHO:
                 begin
                      ReceiverAddr.Visible :=False;
                      GetAreaUplink(DestArea,Link);
                      with Link do
                      SenderAddr.Text :=TFidonetAddress.AddrToStr(SysopAddress);
                      SenderName.Text :=Link.SysopName;
                 end;
               AT_NET:
                 begin
                      // Find best matching Netlink for Netmail
                      ReceiverAddr.Visible :=True;
                      Links                :=TNetLinkList.Create;
                      WinPointAPI.GetUplinks(Links);
                      if Links.Count>0 then
                      begin
                           BestL :=-1;
                           for i:=0 to Links.Count-1 do
                           begin
                                Link  :=Links[i]^;
                                // Determine match Level
                                MatchL :=0;
                                with Link do
                                if SysopAddress.Zone=OrigAddress.Zone then
                                begin
                                     Inc(MatchL);
                                     if SysopAddress.Net=OrigAddress.Net then
                                     begin
                                          Inc(MatchL);
                                          if SysopAddress.Node=OrigAddress.Node
                                          then Inc(MatchL);
                                     end;
                                end;
                                if MatchL>BestL then
                                begin
                                     BestL :=MatchL;
                                     BestM :=i;
                                end;
                           end;
                           Link            :=Links[BestM]^;
                           SenderName.Text :=Link.SysopName;
                           SenderAddr.Text :=TFidonetAddress.AddrToStr(Link.SysopAddress);
                      end;
                      Links.Destroy;
                 end;
               else
                 // Dont know how to handle adressing here
                 begin
                      ReceiverAddr.Visible :=False;
                      SenderName.Text      :='';
                      SenderAddr.Text      :='';
                 end;
               end;
               // Set Destination
               ReceiverName.Text :=MessageInfo.OrigName;
               ReceiverAddr.Text :=TFidonetAddress.AddrToStr(OrigAddress);
               Self.Subject.Text :=MessageInfo.Subject;
               DestArea          :=MessageInfo.Area;
          end;
          // Free Area
          CloseArea;
     end;
     // Display Window
     Show;
     SetForegroundWindow(Handle);
     //=== Perform old moves ====
     Rebuilding :=True;
     WasMate    :=False;
     WasCheck   :=False;
     WasRemis   :=False;
     Data       :=Pointer(TheMsg);
     Inc(Integer(Data),SizeOf(TPakdMessage));
     Inc(Integer(Data),Length(Data)+1);
     Inc(Integer(Data),Length(Data)+1);
     Inc(Integer(Data),Length(Data)+1);
     Chessboard.AnimateMoves :=False;
     // Find moves start
     repeat
           GetLine(Line);
           if (Length(Reply)=0) and (Copy(Line,1,8)=#1'MSGID: ') then
           begin
                Delete(Line,1,8);
                Reply:=Line;
           end;
           if (Length(email)=0) and (UpperCase(Copy(Line,1,6))='FROM: ') then
           begin
                // Get email address
                Delete(Line,1,6);
                i:=Pos('@',Line);
                if i>0 then
                begin
                     while (i>1) and (line[i-1]>' ') do Dec(i);
                     while (i<=Length(line)) and (line[i]>' ') do
                     begin
                          email:=email+line[i];
                          Inc(i);
                     end;
                     if email[1] in ['(','<'] then Delete(email,1,1);
                     if email[Length(email)] in [')','>']
                     then Delete(email,Length(email),1);
                end;
           end;
     until (Data[0]=#0) or (Line='===================');
     while (Data[0]<>#0) and (GetLine(Line)<>'===================') do
     if Length(Line)>0 then
     begin
          // Process move
          while (Length(Line)>5) and not ((Line[1] in ['A'..'H']) and
                                          (Line[2] in ['1'..'8']) and
                                          (Line[3]='-')         and
                                          (Line[4] in ['A'..'H']) and
                                          (Line[5] in ['1'..'8']))
          do Delete(Line,1,1);
          WasMate    :=False;
          WasCheck   :=False;
          WasRemis   :=False;
          if Length(Line)>4 then
          with Chessboard do
          PerformMove(BrdSquare[Ord(Ord(Line[2])-Ord('1')),
                                Ord(Ord(Line[1])-Ord('A'))],
                      BrdSquare[Ord(Ord(Line[5])-Ord('1')),
                                Ord(Ord(Line[4])-Ord('A'))]);
     end;
     Chessboard.AnimateMoves :=True;
     Rebuilding              :=False;
     UpdateMoves;
     // Handle State
     if WasCheck then ShowMessage('Schach!');
     if WasMate  then ShowMessage('Matt!');
     // Free Mail
     Dispose(TheMsg);
     // Make the board ready
     Chessboard.Enabled :=not WasMate;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
     Rebuilding:=False;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
     CancelClick(Sender);
     Action:=caNone;
end;

procedure TForm1.Schlieen1Click(Sender: TObject);
begin
     WinPointAPI.Disconnect;
     Application.Terminate;
end;

procedure TForm1.FormHide(Sender: TObject);
begin
     ShowWindow(Application.Handle,SW_HIDE);
end;

procedure TForm1.FormShow(Sender: TObject);
begin
     ShowWindow(Application.Handle,SW_Show);
end;

procedure TForm1.Info1Click(Sender: TObject);
begin
     About.ShowModal;
end;

procedure TForm1.WinPointAPIWrongVersion(Sender: TObject);
begin
     MessageDlg('Das WinPoint Schach Plugin funktioniert nur mit '+
                'WinPoint 95 Release 1.1 oder h÷her!',mtError,[mbok],0);
end;

procedure TForm1.ContainerResize(Sender: TObject);
begin
     Subject.Width     :=Container.Width;
     ReceiverAddr.Left :=Container.Width-ReceiverAddr.Width;
     SenderAddr.Left   :=Container.Width-SenderAddr.Width;
     if ReceiverAddr.Visible
     then ReceiverName.Width :=Container.Width-ReceiverAddr.Width-4
     else ReceiverName.Width :=Container.Width;
     if SenderAddr.Visible
     then SenderName.Width :=Container.Width-SenderAddr.Width-4
     else SenderName.Width :=Container.Width;
end;

end.