Changeset 6 for trunk/Direct.pas
- Timestamp:
- Jan 7, 2017, 11:32:14 AM (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/Direct.pas
r2 r6 1 1 {$INCLUDE switches} 2 3 2 unit Direct; 4 3 … … 11 10 12 11 const 13 WM_GO = WM_USER;14 WM_CHANGECLIENT = WM_USER+1; // hand over control to other client15 WM_NEXTPLAYER = WM_USER+2; // active player's turn ended, next player16 WM_AIEXCEPTION = WM_USER+3;12 WM_GO = WM_USER; 13 WM_CHANGECLIENT = WM_USER + 1; // hand over control to other client 14 WM_NEXTPLAYER = WM_USER + 2; // active player's turn ended, next player 15 WM_AIEXCEPTION = WM_USER + 3; 17 16 18 17 type … … 30 29 procedure SetInfo(x: string); 31 30 procedure SetState(x: integer); 32 procedure OnGo(var m: TMessage); message WM_GO;33 procedure OnChangeClient(var m: TMessage); message WM_CHANGECLIENT;34 procedure OnNextPlayer(var m: TMessage); message WM_NEXTPLAYER;35 procedure OnAIException(var Msg: TMessage); message WM_AIEXCEPTION;31 procedure OnGo(var m: TMessage); message WM_GO; 32 procedure OnChangeClient(var m: TMessage); message WM_CHANGECLIENT; 33 procedure OnNextPlayer(var m: TMessage); message WM_NEXTPLAYER; 34 procedure OnAIException(var Msg: TMessage); message WM_AIEXCEPTION; 36 35 end; 37 36 … … 42 41 43 42 uses 44 ScreenTools,Protocol,GameServer,Start,LocalPlayer,NoTerm,Back,ShellAPI;43 ScreenTools, Protocol, GameServer, Start, LocalPlayer, NoTerm, Back, ShellAPI; 45 44 46 45 {$R *.DFM} … … 48 47 procedure Notify(ID: integer); 49 48 begin 50 DirectDlg.DlgNotify(ID);49 DirectDlg.DlgNotify(ID); 51 50 end; 52 51 53 52 procedure TDirectDlg.DlgNotify(ID: integer); 54 53 var 55 hMem: Cardinal; 56 p: pointer; 57 s: string; 58 begin 59 case ID of 60 ntInitLocalHuman: 54 hMem: Cardinal; 55 p: pointer; 56 s: string; 57 begin 58 case ID of 59 ntInitLocalHuman: 60 begin 61 SetMainTextureByAge(-1); 62 State := -1; 63 Info := Phrases.Lookup('BUSY_MODLH'); 64 Show; 65 Invalidate; 66 Update; 67 end; 68 ntInitModule .. ntInitModule + maxBrain - 1: 69 if visible then 70 begin 71 s := Format(Phrases.Lookup('BUSY_MOD'), 72 [Brain[ID - ntInitModule].Name]); 73 while BiColorTextWidth(Canvas, s) + 64 > ClientWidth do 74 Delete(s, Length(s), 1); 75 SetInfo(s); 76 end; 77 ntCreateWorld: 78 if visible then 79 SetInfo(Phrases.Lookup('BUSY_START')); 80 ntInitPlayers: 81 if visible then 82 SetInfo(Phrases.Lookup('BUSY_INIT')); 83 ntDeactivationMissing .. ntDeactivationMissing + nPl - 1: 84 SimpleMessage(Format(Phrases.Lookup('MISSDEACT'), 85 [ID - ntDeactivationMissing])); 86 ntSetAIName .. ntSetAIName + nPl - 1: 87 LocalPlayer.SetAIName(ID - ntSetAIName, NotifyMessage); 88 ntException .. ntException + maxBrain - 1: 89 PostMessage(Handle, WM_AIEXCEPTION, ID - ntException, 0); 90 ntLoadBegin: 91 begin 92 Info := Phrases.Lookup('BUSY_LOAD'); 93 SetState(0); 94 end; 95 ntLoadState .. ntLoadState + 128: 96 SetState(ID - ntLoadState); 97 ntDLLError .. ntDLLError + 128: 98 SimpleMessage(Format(Phrases.Lookup('DLLERROR'), 99 [Brain[ID - ntDLLError].FileName])); 100 ntAIError: 101 SimpleMessage(Format(Phrases.Lookup('AIERROR'), [NotifyMessage])); 102 ntClientError .. ntClientError + 128: 103 SimpleMessage(Format(Phrases.Lookup('CLIENTERROR'), 104 [Brain[ID - ntClientError].FileName])); 105 ntEndInfo: 106 begin 107 Hide; 108 background.Update 109 end; 110 ntLoadError: 111 begin 112 if OpenClipboard(Handle) then 113 begin // copy file path to clipboard 114 NotifyMessage := NotifyMessage + #0; 115 hMem := GlobalAlloc(GMEM_MOVEABLE or GMEM_DDESHARE, 116 Length(NotifyMessage)); 117 p := GlobalLock(hMem); 118 if p <> nil then 119 move(NotifyMessage[1], p^, Length(NotifyMessage)); 120 GlobalUnlock(hMem); 121 SetClipboardData(CF_TEXT, hMem); 122 CloseClipboard; 123 end; 124 with MessgDlg do 125 begin 126 MessgText := Phrases.Lookup('LOADERROR'); 127 Kind := mkYesNo; 128 ShowModal; 129 if ModalResult = mrOK then 130 ShellExecute(Handle, 'open', 131 'http://c-evo.org/_sg/contact/cevobug.html', '', '', 132 SW_SHOWNORMAL); 133 end 134 end; 135 ntStartDone: 136 if not Quick then 137 begin 138 StartDlg.Hide; 139 background.Update 140 end; 141 ntStartGo, ntStartGoRefresh, ntStartGoRefreshMaps: 142 if Quick then 143 Close 144 else 145 begin 146 if ID = ntStartGoRefresh then 147 StartDlg.UpdateFormerGames 148 else if ID = ntStartGoRefreshMaps then 149 StartDlg.UpdateMaps; 150 StartDlg.Show; 151 end; 152 ntChangeClient: 153 PostMessage(Handle, WM_CHANGECLIENT, 0, 0); 154 ntNextPlayer: 155 PostMessage(Handle, WM_NEXTPLAYER, 0, 0); 156 ntDeinitModule .. ntDeinitModule + maxBrain - 1: 157 begin 158 Info := Format(Phrases2.Lookup('BUSY_DEINIT'), 159 [Brain[ID - ntDeinitModule].Name]); 160 while BiColorTextWidth(Canvas, Info) + 64 > ClientWidth do 161 Delete(Info, Length(Info), 1); 162 SetMainTextureByAge(-1); 163 State := -1; 164 Show; 165 Invalidate; 166 Update; 167 end; 168 ntBackOn: 169 begin 170 background.Show; 171 background.Update; 172 sleep(50); // prevent flickering 173 end; 174 ntBackOff: 175 background.Close; 176 end; 177 end; 178 179 procedure TDirectDlg.FormCreate(Sender: TObject); 180 begin 181 Gone := false; 182 State := -1; 183 Info := ''; 184 GameServer.Init(Notify); 185 Brain[bixNoTerm].Client := NoTerm.Client; 186 Brain[bixSuper_Virtual].Client := nil; 187 Brain[bixTerm].Client := LocalPlayer.Client; 188 Brain[bixNoTerm].Name := Phrases.Lookup('AIT'); 189 Brain[bixSuper_Virtual].Name := Phrases.Lookup('SUPER'); 190 Brain[bixTerm].Name := Phrases.Lookup('HUMAN'); 191 Brain[bixRandom].Name := Phrases.Lookup('RANDOMAI'); 192 Canvas.Font.Assign(UniFont[ftNormal]); 193 Canvas.Brush.Style := bsClear; 194 end; 195 196 procedure TDirectDlg.FormShow(Sender: TObject); 197 begin 198 if not Gone then 199 begin 200 PostMessage(Handle, WM_GO, 0, 0); 201 Gone := true 202 end 203 end; 204 205 procedure TDirectDlg.FormClose(Sender: TObject; var Action: TCloseAction); 206 begin 207 GameServer.Done; 208 end; 209 210 procedure TDirectDlg.OnGo(var m: TMessage); 211 var 212 i: integer; 213 s: string; 214 begin 215 Hide; 216 if nBrain = 3 then 217 begin 218 Application.MessageBox(PChar(Phrases.Lookup('NOAI')), 'C-evo', 0); 219 Close; 220 exit 221 end; 222 Quick := false; 223 if ParamCount > 0 then 224 begin 225 s := ParamStr(1); 226 if (s[1] = '-') or (s[1] = '/') then 227 begin // special mode 228 Delete(s, 1, 1); 229 for i := 1 to Length(s) do 230 if s[i] in ['a' .. 'z'] then 231 dec(s[i], 32); 232 if s = 'MAN' then 233 begin 234 Quick := true; 235 DirectHelp(cHelpOnly); 236 Close 237 end; 238 end 239 else if (FileExists(ParamStr(1))) then 61 240 begin 62 SetMainTextureByAge(-1); 63 State:=-1; 64 Info:=Phrases.Lookup('BUSY_MODLH'); 65 Show; Invalidate; Update; 66 end; 67 ntInitModule..ntInitModule+maxBrain-1: 68 if visible then 69 begin 70 s:=Format(Phrases.Lookup('BUSY_MOD'),[Brain[ID-ntInitModule].Name]); 71 while BiColorTextWidth(Canvas,s)+64>ClientWidth do Delete(s,Length(s),1); 72 SetInfo(s); 73 end; 74 ntCreateWorld: 75 if visible then SetInfo(Phrases.Lookup('BUSY_START')); 76 ntInitPlayers: 77 if visible then SetInfo(Phrases.Lookup('BUSY_INIT')); 78 ntDeactivationMissing..ntDeactivationMissing+nPl-1: 79 SimpleMessage(Format(Phrases.Lookup('MISSDEACT'),[ID-ntDeactivationMissing])); 80 ntSetAIName..ntSetAIName+nPl-1: 81 LocalPlayer.SetAIName(ID-ntSetAIName, NotifyMessage); 82 ntException..ntException+maxBrain-1: 83 PostMessage(Handle,WM_AIEXCEPTION,ID-ntException,0); 84 ntLoadBegin: 85 begin Info:=Phrases.Lookup('BUSY_LOAD'); SetState(0); end; 86 ntLoadState..ntLoadState+128: 87 SetState(ID-ntLoadState); 88 ntDLLError..ntDLLError+128: 89 SimpleMessage(Format(Phrases.Lookup('DLLERROR'),[Brain[ID-ntDLLError].FileName])); 90 ntAIError: 91 SimpleMessage(Format(Phrases.Lookup('AIERROR'),[NotifyMessage])); 92 ntClientError..ntClientError+128: 93 SimpleMessage(Format(Phrases.Lookup('CLIENTERROR'),[Brain[ID-ntClientError].FileName])); 94 ntEndInfo: 95 begin Hide; background.update end; 96 ntLoadError: 97 begin 98 if OpenClipboard(Handle) then 99 begin // copy file path to clipboard 100 NotifyMessage:=NotifyMessage+#0; 101 hMem:=GlobalAlloc(GMEM_MOVEABLE or GMEM_DDESHARE, Length(NotifyMessage)); 102 p:=GlobalLock(hMem); 103 if p<>nil then 104 move(NotifyMessage[1],p^,Length(NotifyMessage)); 105 GlobalUnlock(hMem); 106 SetClipboardData(CF_TEXT, hMem); 107 CloseClipboard; 108 end; 109 with MessgDlg do 110 begin 111 MessgText:=Phrases.Lookup('LOADERROR'); 112 Kind:=mkYesNo; 113 ShowModal; 114 if ModalResult=mrOK then 115 ShellExecute(Handle,'open','http://c-evo.org/_sg/contact/cevobug.html', 116 '','',SW_SHOWNORMAL); 117 end 118 end; 119 ntStartDone: 120 if not Quick then 121 begin StartDlg.Hide; background.Update end; 122 ntStartGo, ntStartGoRefresh, ntStartGoRefreshMaps: 123 if Quick then Close 124 else 125 begin 126 if ID=ntStartGoRefresh then 127 StartDlg.UpdateFormerGames 128 else if ID=ntStartGoRefreshMaps then 129 StartDlg.UpdateMaps; 130 StartDlg.Show; 131 end; 132 ntChangeClient: 133 PostMessage(Handle,WM_CHANGECLIENT,0,0); 134 ntNextPlayer: 135 PostMessage(Handle,WM_NEXTPLAYER,0,0); 136 ntDeinitModule..ntDeinitModule+maxBrain-1: 137 begin 138 Info:=Format(Phrases2.Lookup('BUSY_DEINIT'), 139 [Brain[ID-ntDeinitModule].Name]); 140 while BiColorTextWidth(Canvas,Info)+64>ClientWidth do 141 Delete(Info,Length(Info),1); 142 SetMainTextureByAge(-1); 143 State:=-1; 144 Show; 145 Invalidate; 146 Update; 147 end; 148 ntBackOn: 149 begin 150 background.Show; 151 background.update; 152 sleep(50); // prevent flickering 153 end; 154 ntBackOff: 155 background.Close; 156 end; 157 end; 158 159 procedure TDirectDlg.FormCreate(Sender: TObject); 160 begin 161 Gone:=false; 162 State:=-1; 163 Info:=''; 164 GameServer.Init(Notify); 165 Brain[bixNoTerm].Client:=NoTerm.Client; 166 Brain[bixSuper_Virtual].Client:=nil; 167 Brain[bixTerm].Client:=LocalPlayer.Client; 168 Brain[bixNoTerm].Name:=Phrases.Lookup('AIT'); 169 Brain[bixSuper_Virtual].Name:=Phrases.Lookup('SUPER'); 170 Brain[bixTerm].Name:=Phrases.Lookup('HUMAN'); 171 Brain[bixRandom].name:=Phrases.Lookup('RANDOMAI'); 172 Canvas.Font.Assign(UniFont[ftNormal]); 173 Canvas.Brush.Style:=bsClear; 174 end; 175 176 procedure TDirectDlg.FormShow(Sender: TObject); 177 begin 178 if not Gone then 179 begin PostMessage(Handle,WM_GO,0,0); Gone:=true end 180 end; 181 182 procedure TDirectDlg.FormClose(Sender: TObject; var Action: TCloseAction); 183 begin 184 GameServer.Done; 185 end; 186 187 procedure TDirectDlg.OnGo(var m:TMessage); 188 var 189 i: integer; 190 s: string; 191 begin 192 Hide; 193 if nBrain=3 then 194 begin 195 Application.MessageBox(PChar(Phrases.Lookup('NOAI')), 'C-evo', 0); 196 close; 197 exit 198 end; 199 Quick:=false; 200 if ParamCount>0 then 201 begin 202 s:=ParamStr(1); 203 if (s[1]='-') or (s[1]='/') then 204 begin // special mode 205 Delete(s,1,1); 206 for i:=1 to Length(s) do if s[i] in ['a'..'z'] then dec(s[i],32); 207 if s='MAN' then 208 begin Quick:=true; DirectHelp(cHelpOnly); Close end; 209 end 210 else if (FileExists(ParamStr(1))) then 211 begin 212 Quick:=true; 213 if not LoadGame(ExtractFilePath(ParamStr(1)),ExtractFileName(ParamStr(1)),-1,false) then 214 begin 215 SimpleMessage(Phrases.Lookup('LOADERR')); 216 Close 241 Quick := true; 242 if not LoadGame(ExtractFilePath(ParamStr(1)), ExtractFileName(ParamStr(1) 243 ), -1, false) then 244 begin 245 SimpleMessage(Phrases.Lookup('LOADERR')); 246 Close 217 247 end 218 248 end 219 249 end; 220 if not Quick then 221 begin background.Show; StartDlg.Show end 222 end; 223 224 procedure TDirectDlg.OnChangeClient(var m:TMessage); 225 begin 226 ChangeClient; 227 end; 228 229 procedure TDirectDlg.OnNextPlayer(var m:TMessage); 230 begin 231 NextPlayer; 232 end; 233 234 procedure TDirectDlg.OnAIException(var Msg:TMessage); 235 begin 236 Application.MessageBox(PChar(Format(Phrases.Lookup('AIEXCEPTION'), 237 [Brain[Msg.WParam].Name])), 'C-evo', 0); 250 if not Quick then 251 begin 252 background.Show; 253 StartDlg.Show 254 end 255 end; 256 257 procedure TDirectDlg.OnChangeClient(var m: TMessage); 258 begin 259 ChangeClient; 260 end; 261 262 procedure TDirectDlg.OnNextPlayer(var m: TMessage); 263 begin 264 NextPlayer; 265 end; 266 267 procedure TDirectDlg.OnAIException(var Msg: TMessage); 268 begin 269 Application.MessageBox(PChar(Format(Phrases.Lookup('AIEXCEPTION'), 270 [Brain[Msg.WParam].Name])), 'C-evo', 0); 238 271 end; 239 272 240 273 procedure TDirectDlg.FormPaint(Sender: TObject); 241 274 begin 242 PaintBackground(self,3,3,ClientWidth-6,ClientHeight-6); 243 Frame(Canvas,0,0,ClientWidth-1,ClientHeight-1,0,0); 244 Frame(Canvas,1,1,ClientWidth-2,ClientHeight-2,MainTexture.clBevelLight, 245 MainTexture.clBevelShade); 246 Frame(Canvas,2,2,ClientWidth-3,ClientHeight-3,MainTexture.clBevelLight, 247 MainTexture.clBevelShade); 248 if State>=0 then 249 RisedTextOut(Canvas,(ClientWidth-BiColorTextWidth(Canvas,Info)) div 2,16,Info) 250 else RisedTextOut(Canvas,(ClientWidth-BiColorTextWidth(Canvas,Info)) div 2, 251 (ClientHeight-Canvas.TextHeight(Info)) div 2,Info); 252 if State>=0 then 253 PaintProgressBar(Canvas,3,ClientWidth div 2 -64,40,State,0,128,MainTexture); 275 PaintBackground(self, 3, 3, ClientWidth - 6, ClientHeight - 6); 276 Frame(Canvas, 0, 0, ClientWidth - 1, ClientHeight - 1, 0, 0); 277 Frame(Canvas, 1, 1, ClientWidth - 2, ClientHeight - 2, 278 MainTexture.clBevelLight, MainTexture.clBevelShade); 279 Frame(Canvas, 2, 2, ClientWidth - 3, ClientHeight - 3, 280 MainTexture.clBevelLight, MainTexture.clBevelShade); 281 if State >= 0 then 282 RisedTextOut(Canvas, (ClientWidth - BiColorTextWidth(Canvas, Info)) 283 div 2, 16, Info) 284 else 285 RisedTextOut(Canvas, (ClientWidth - BiColorTextWidth(Canvas, Info)) div 2, 286 (ClientHeight - Canvas.TextHeight(Info)) div 2, Info); 287 if State >= 0 then 288 PaintProgressBar(Canvas, 3, ClientWidth div 2 - 64, 40, State, 0, 128, 289 MainTexture); 254 290 end; 255 291 256 292 procedure TDirectDlg.SetInfo(x: string); 257 293 begin 258 Info:=x;259 Invalidate;260 Update;294 Info := x; 295 Invalidate; 296 Update; 261 297 end; 262 298 263 299 procedure TDirectDlg.SetState(x: integer); 264 300 begin 265 if (x<0)<>(State<0) then 266 begin State:=x; Invalidate; Update end 267 else if x<>State then 268 begin 269 State:=x; 270 PaintProgressBar(Canvas,6,ClientWidth div 2 -64,40,State,128-State,128,MainTexture); 301 if (x < 0) <> (State < 0) then 302 begin 303 State := x; 304 Invalidate; 305 Update 271 306 end 307 else if x <> State then 308 begin 309 State := x; 310 PaintProgressBar(Canvas, 6, ClientWidth div 2 - 64, 40, State, 128 - State, 311 128, MainTexture); 312 end 272 313 end; 273 314 274 315 end. 275
Note:
See TracChangeset
for help on using the changeset viewer.