source: trunk/Main.pas

Last change on this file was 14, checked in by george, 16 years ago
  • Upraveno: Informace o nových verzích umístěny do souboru ReleaseNotes.txt.
File size: 51.4 KB
Line 
1unit Main;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7 Dialogs, StdCtrls, Menus, ImgList, ComCtrls, XPMan, CoolTrayIcon, Registry, ShellApi,
8 //WinSkinData,
9 ExtCtrls, xmldom, XMLIntf, msxmldom, XMLDoc,
10 IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP, RichEdit,
11 IdRawBase, IdRawClient, IdIcmpClient, MPlayer;
12
13const
14 ApplicationVersion = '3.4';
15 ApplicationRevision = 7;
16 R = '\Software\maronsoft\Heroes of Fantasy client pack\';
17 HoFWeb = 'www.heroesoffantasy.cz';
18 HoFRealmList = 'heroesoffantasy.cz';
19 UpdateInfoFile = 'http://' + HoFWeb + '/client/aktualizace.txt';
20 DefaultRSSChannel = 'http://' + HoFWeb + '/rss.php?category=articles';
21 OldRSSChannel = 'http://' + HoFWeb + '/rss.php';
22 AoWoWSearchURL = 'http://wowpreklad.zdechov.net/aowow/?search=';
23 HoFOnlineListURL = 'http://' + HoFWeb + '/stat/stat.xml';
24 ProjectHomepage = 'http://' + HoFWeb + '/?page=client';
25 AuthorEmail = 'maron2@centrum.cz';
26
27type
28 TWMMoving = record
29 Msg: Cardinal;
30 Side: Longint;
31 Coord: PRect;
32 Unused: longint;
33 end;
34
35type
36 TVlakno = class(TThread)
37 private
38 protected
39 procedure Execute; override;
40 procedure Update;
41 end;
42
43 TServer = record
44 Name: string;
45 Address: string;
46 ExeFile: string;
47 Image: string;
48 Description: string;
49 OnlinePlayersAddress: string;
50 end;
51
52 TForm1 = class(TForm)
53 MainMenu1: TMainMenu;
54 Menu1: TMenuItem;
55 N1: TMenuItem;
56 Konec1: TMenuItem;
57 N2: TMenuItem;
58 About1: TMenuItem;
59 Oprogramu1: TMenuItem;
60 Npovda1: TMenuItem;
61 ImageList16: TImageList;
62 Zobrazen1: TMenuItem;
63 Seznam1: TMenuItem;
64 Podrobnosti1: TMenuItem;
65 Vedlesebe1: TMenuItem;
66 Ikony1: TMenuItem;
67 ImageList32: TImageList;
68 XPManifest1: TXPManifest;
69 CoolTrayIcon1: TCoolTrayIcon;
70 PopupMenu1: TPopupMenu;
71 N3: TMenuItem;
72 Zobrazit1: TMenuItem;
73 Konec2: TMenuItem;
74 Servery1: TMenuItem;
75 Pidat1: TMenuItem;
76 Vymazatoznaen1: TMenuItem;
77 Vymazatvechny1: TMenuItem;
78 Editovatoznaen1: TMenuItem;
79 PopupMenu2: TPopupMenu;
80 Editovatoznaen2: TMenuItem;
81 Smazat1: TMenuItem;
82 ImageList16default: TImageList;
83 ImageList32default: TImageList;
84 Zobrazen2: TMenuItem;
85 OnlineHri1: TMenuItem;
86 Aktuality1: TMenuItem;
87 Timer1: TTimer;
88 StatusBar1: TStatusBar;
89 Timer2: TTimer;
90 PidatHeroesofFantasy1: TMenuItem;
91 Timer3: TTimer;
92 IdHTTP1: TIdHTTP;
93 Zkontrolovatverziprogramu1: TMenuItem;
94 Exportovatserver1: TMenuItem;
95 Importovatserver1: TMenuItem;
96 N6: TMenuItem;
97 SaveDialog1: TSaveDialog;
98 OpenDialog1: TOpenDialog;
99 XMLDocument1: TXMLDocument;
100 ExportovatdoXML1: TMenuItem;
101 Panel1: TPanel;
102 Edit1: TEdit;
103 Image1: TImage;
104 Image2: TImage;
105 Image3: TImage;
106 Importz1: TMenuItem;
107 Image4: TImage;
108 Importzwowstatusnet1: TMenuItem;
109 Label1: TLabel;
110 Label2: TLabel;
111 RichEdit1: TRichEdit;
112 Button1: TButton;
113 IdIcmpClient1: TIdIcmpClient;
114 Timer4: TTimer;
115 ListView1: TListView;
116 Panel2: TPanel;
117 MediaPlayer1: TMediaPlayer;
118 Pipojit1: TMenuItem;
119 PopupMenu3: TPopupMenu;
120 Pidatrun1: TMenuItem;
121 PidatHeroesofFantasy2: TMenuItem;
122 ImportovatzXML1: TMenuItem;
123 Importzserverywowresourceeu1: TMenuItem;
124 Importzwowstatusnet2: TMenuItem;
125 Zkoprovatfonty1: TMenuItem;
126 Pidat2: TMenuItem;
127 procedure Seznam1Click(Sender: TObject);
128 procedure Podrobnosti1Click(Sender: TObject);
129 procedure Vedlesebe1Click(Sender: TObject);
130 procedure Ikony1Click(Sender: TObject);
131 procedure N1Click(Sender: TObject);
132 procedure Oprogramu1Click(Sender: TObject);
133 procedure CoolTrayIcon1Click(Sender: TObject);
134 procedure Zobrazit1Click(Sender: TObject);
135 procedure FormCreate(Sender: TObject);
136 procedure Konec1Click(Sender: TObject);
137 procedure ListView1DblClick(Sender: TObject);
138 procedure Pidat1Click(Sender: TObject);
139 procedure Editovatoznaen1Click(Sender: TObject);
140 procedure Vymazatoznaen1Click(Sender: TObject);
141 procedure Vymazatvechny1Click(Sender: TObject);
142 procedure OnlineHri1Click(Sender: TObject);
143 procedure Aktuality1Click(Sender: TObject);
144 procedure Panel2MouseUp(Sender: TObject; Button: TMouseButton;
145 Shift: TShiftState; X, Y: Integer);
146 procedure Timer1Timer(Sender: TObject);
147 procedure ListView1MouseMove(Sender: TObject; Shift: TShiftState; X,
148 Y: Integer);
149 procedure Timer2Timer(Sender: TObject);
150 procedure ListView1SelectItem(Sender: TObject; Item: TListItem;
151 Selected: Boolean);
152 procedure PidatHeroesofFantasy1Click(Sender: TObject);
153 procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
154 procedure Timer3Timer(Sender: TObject);
155 procedure Zkontrolovatverziprogramu1Click(Sender: TObject);
156 procedure Npovda1Click(Sender: TObject);
157 procedure ListView1KeyDown(Sender: TObject; var Key: Word;
158 Shift: TShiftState);
159 procedure Exportovatserver1Click(Sender: TObject);
160 procedure ExportovatdoXML1Click(Sender: TObject);
161 procedure Edit1Click(Sender: TObject);
162 procedure Image1Click(Sender: TObject);
163 procedure Image2Click(Sender: TObject);
164 procedure Image3Click(Sender: TObject);
165 procedure Edit1KeyPress(Sender: TObject; var Key: Char);
166 procedure Importovatserver1Click(Sender: TObject);
167 procedure PopupMenu2Popup(Sender: TObject);
168 procedure Importz1Click(Sender: TObject);
169 procedure MainMenu1Change(Sender: TObject; Source: TMenuItem;
170 Rebuild: Boolean);
171 procedure Image4Click(Sender: TObject);
172 procedure ListView1MouseDown(Sender: TObject; Button: TMouseButton;
173 Shift: TShiftState; X, Y: Integer);
174 procedure Importzwowstatusnet1Click(Sender: TObject);
175 procedure Panel2MouseDown(Sender: TObject; Button: TMouseButton;
176 Shift: TShiftState; X, Y: Integer);
177 procedure Panel2MouseMove(Sender: TObject; Shift: TShiftState; X,
178 Y: Integer);
179 procedure Button1Click(Sender: TObject);
180 procedure IdIcmpClient1Reply(ASender: TComponent;
181 const AReplyStatus: TReplyStatus);
182 procedure Timer4Timer(Sender: TObject);
183 procedure FormResize(Sender: TObject);
184 procedure Pidatrun1Click(Sender: TObject);
185 procedure PidatHeroesofFantasy2Click(Sender: TObject);
186 procedure ImportovatzXML1Click(Sender: TObject);
187 procedure Importzserverywowresourceeu1Click(Sender: TObject);
188 procedure Importzwowstatusnet2Click(Sender: TObject);
189 procedure Zkoprovatfonty1Click(Sender: TObject);
190 procedure FormDestroy(Sender: TObject);
191 procedure FormShow(Sender: TObject);
192 private
193 { Private declarations }
194 procedure PopupMenuItemsClick(Sender: TObject);
195 procedure WMMoving(var Message: TWMMoving); message WM_MOVING;
196 procedure OpenSearchURL(URL: string);
197 function GetTypeFile(SourceFile: string): string;
198 procedure ConnectSever(SeverIndex: integer);
199 procedure ResizeBitmap(const Source: TBitmap; var Target: TBitmap; NewWidth, NewHeight: Integer);
200 public
201 { Public declarations }
202
203 // veřejné proměné
204 Servers: array of TServer;
205
206 //obecné procedury
207 procedure CopyFontsProcedure(SeverIndex: integer);
208 procedure CopyFiles(Source, Destination : string);
209 function ReallyYes(Text: string): Boolean;
210 procedure DrawForm;
211 procedure MediaPlay(MediaFile: string);
212 function GetWoWExeFile: string;
213 procedure ShowOnlinePlayers;
214 procedure ShowNews;
215 procedure DrawDetail;
216 procedure FinalyClose;
217 function NeedUpdate: Boolean;
218 procedure ProcedureUpdateApplication;
219 procedure ShowWeb;
220 procedure ImportXMLfile;
221 procedure InitRichEditURLDetection(RE: TRichEdit);
222
223
224 //hlavní procedury ukládání, načítání, vypisování
225 procedure LoadRegOptions;
226 procedure LoadRegServers;
227
228 procedure WriteImages;
229 procedure WriteServers;
230
231 procedure SaveRegOptions;
232 procedure SaveRegServers;
233 protected
234 procedure WndProc(var Msg: TMessage); override;
235 end;
236
237var
238 Form1: TForm1;
239 //nastavení
240 StartMinimalize: Boolean = False;
241 OnCloseMinimalize: Boolean = True;
242 AfterWoWStartClose: Boolean = False;
243 AfterWoWStartMinimalize: Boolean = True;
244 UpdateApplication: Boolean = True;
245 SoundAfterNewNews: Boolean = True;
246 ShowBalloonHint: Boolean = True;
247 ShowDetails: Boolean = False;
248 // MakePing: boolean = True;
249 RSSAddress: string;
250 CopyFonts: Boolean = True;
251
252 //posuvný panel
253 StartPosition: TPoint;
254 DragDown: Boolean;
255
256 //přichytávání okna
257 DockingOnlinePlayers: Boolean = True;
258 DockingNews: Boolean = True;
259 Desktop: TRect;
260
261 Vlakno: TVlakno;
262
263implementation
264
265uses Options, About, Add, Math, OnlinePlayers, Types, News, Details,
266 StrUtils, ImportZWebu, Loading;
267
268{$R *.dfm}
269
270procedure TForm1.Seznam1Click(Sender: TObject);
271begin
272 ListView1.ViewStyle := vsList;
273end;
274
275procedure TForm1.Podrobnosti1Click(Sender: TObject);
276begin
277 ListView1.ViewStyle := vsReport;
278end;
279
280procedure TForm1.Vedlesebe1Click(Sender: TObject);
281begin
282 ListView1.ViewStyle := vsSmallIcon;
283end;
284
285procedure TForm1.Ikony1Click(Sender: TObject);
286begin
287 ListView1.ViewStyle := vsIcon;
288end;
289
290procedure TForm1.N1Click(Sender: TObject);
291begin
292 Timer3.Enabled := False;
293 Form2.ShowModal;
294end;
295
296procedure TForm1.Oprogramu1Click(Sender: TObject);
297begin
298 Form3.Show;
299end;
300
301procedure TForm1.CoolTrayIcon1Click(Sender: TObject);
302begin
303 if Form1.Showing then begin
304 Application.Minimize;
305 end else begin
306 CoolTrayIcon1.ShowMainForm;
307 If (Form5.Showing = false) and OnlineHri1.Checked then
308 Form5.Show;
309 If (Form6.Showing = false) and Aktuality1.Checked then
310 Form6.Show;
311 end;
312end;
313
314procedure TForm1.Zobrazit1Click(Sender: TObject);
315begin
316 CoolTrayIcon1Click(nil);
317end;
318
319procedure TForm1.LoadRegServers;
320var
321 reg: TRegistry;
322 ServerCount: Integer;
323 i: Integer;
324begin
325 // načítání seznamů serverů z registrů
326// ServerCount := 0; //žádný záznam v registrech
327 Reg := TRegistry.Create;
328 try
329 if Reg.OpenKey(R, False) then begin
330 if reg.ValueExists('počet') then begin
331 ServerCount := Reg.ReadInteger('počet');
332 SetLength(Servers, ServerCount);
333 for i := 0 to ServerCount-1 do
334 if Reg.OpenKey(R+'Listview'+IntToStr(i), False) then
335 with Servers[I] do begin
336 Name := Reg.ReadString('name');
337 Address := Reg.ReadString('server');
338 ExeFile := Reg.ReadString('file');
339 Description := Reg.ReadString('description');
340 Image := Reg.ReadString('image');
341 OnlinePlayersAddress := Reg.ReadString('OnlinePlayersAddress');
342 end;
343 end;
344 end else begin
345 // standartní servery
346 SetLength(Servers, 3);
347 Servers[0].Name := 'Heroes of Fantasy';
348 Servers[0].Address := HoFRealmList;
349 Servers[0].OnlinePlayersAddress := HoFOnlineListURL;
350 Servers[0].ExeFile := GetWoWExeFile;
351 Servers[0].Image := '1';
352 Servers[0].Description := 'Free server'#13#10'Server podporovaný výrobcem programu'#13#10'web: http://' + HoFWeb + '/'#13#10'reamlist: ' + HoFRealmList;
353
354 Servers[1].Name := 'Oficiální Server - Eu';
355 Servers[1].Address := 'eu.logon.worldofwarcraft.com';
356 Servers[1].ExeFile := GetWoWExeFile;
357 Servers[1].Image := '';
358 Servers[1].Description := 'Oficiální server - Evropa'#13#10'Web: http://www.wow-europe.com/';
359
360 Servers[2].Name := 'Oficiální Server - USA';
361 Servers[2].Address := 'us.logon.worldofwarcraft.com';
362 Servers[2].ExeFile := GetWoWExeFile;
363 Servers[2].Image := '';
364 Servers[2].Description := 'Oficiální server - Evropa'#13#10'Web: http://www.worldofwarcraft.com/';
365 end;
366
367 finally
368 Reg.Free;
369 end;
370end;
371
372procedure TForm1.FormCreate(Sender: TObject);
373begin
374 Timer4.Enabled := False;
375 //Vlakno := TVlakno.Create(True);
376
377 // Načítání nastavení a vypsání
378 LoadRegOptions;
379 LoadRegServers;
380 WriteImages;
381 WriteServers;
382
383 // Akce na záhladě nastavení
384 if StartMinimalize then
385 Application.ShowMainForm := False;
386
387 // ostatní
388 Form1.Caption := Form1.Caption + ' ' + ApplicationVersion;
389 SystemParametersInfo(SPI_GETWORKAREA, 0, @Desktop, 0);
390 InitRichEditURLDetection(RichEdit1);
391
392 // zjištění aktualizace
393 if UpdateApplication then
394 if NeedUpdate then
395 ProcedureUpdateApplication;
396end;
397
398procedure TForm1.FormDestroy(Sender: TObject);
399begin
400 Vlakno.WaitFor;
401 Vlakno.Free;
402end;
403
404procedure TForm1.WriteServers;
405var
406 i: Integer;
407 NewItem: TlistItem;
408 NewMenuItem: TMenuItem;
409begin
410 //vypsání hlavního seznamu serverů
411 ListView1.Items.BeginUpdate;
412 ListView1.Items.Clear;
413 for i := 0 to High(servers) do
414 with servers[i], ListView1.Items do begin
415 NewItem := Add;
416 NewItem.Caption := Name;
417 NewItem.ImageIndex := i;
418 With NewItem.SubItems do begin
419 Add(Address);
420 Add(ExeFile);
421 end;
422 end;
423 ListView1.Items.EndUpdate;
424
425 //vypsání kontextového menu
426 PopupMenu1.Items.Clear;
427
428 NewMenuItem := TMenuItem.Create(PopupMenu1);
429 PopupMenu1.Items.Insert(0, NewMenuItem);
430 NewMenuItem.Caption := 'Konec';
431 NewMenuItem.OnClick := Konec1Click;
432 // NewMenuItem.Default := True;
433
434 NewMenuItem := TMenuItem.Create(PopupMenu1);
435 PopupMenu1.Items.Insert(0, NewMenuItem);
436 NewMenuItem.Caption := 'Zobrazit/Skrýt';
437 NewMenuItem.OnClick := Zobrazit1Click;
438
439 NewMenuItem := TMenuItem.Create(PopupMenu1);
440 PopupMenu1.Items.Insert(0, NewMenuItem);
441 NewMenuItem.Caption := '-';
442
443 for I:= 0 to High(Servers) do begin
444 NewMenuItem := TMenuItem.Create(PopupMenu1); // create the new item
445 PopupMenu1.Items.Insert(0, NewMenuItem);// add it to the Popupmenu
446 NewMenuItem.Caption := Servers[i].Name;
447 NewMenuItem.Tag := I;
448 NewMenuItem.OnClick := PopupMenuItemsClick;// assign it an event handler
449 NewMenuItem.ImageIndex := i;
450 end;
451end;
452
453procedure TForm1.Konec1Click(Sender: TObject);
454begin
455 FinalyClose;
456 OnCloseMinimalize := False;
457 Close;
458end;
459
460procedure TForm1.PopupMenuItemsClick(Sender: TObject);
461begin
462 with Sender as TMenuItem do
463 begin
464 ConnectSever(Tag);
465 end;
466end;
467
468procedure TForm1.ConnectSever(SeverIndex: integer);
469var
470 MyTextFile: TextFile;
471begin
472 try
473 AssignFile(MyTextFile, ExtractFileDir(Servers[SeverIndex].ExeFile)+'\realmlist.wtf');
474 Rewrite(MyTextFile);
475 Write(MyTextFile, 'set realmlist ' + servers[SeverIndex].Address);
476 CloseFile(MyTextFile);
477
478 AssignFile(MyTextFile, ExtractFileDir(Servers[SeverIndex].ExeFile)+'\WoW473519.wtf');
479 Rewrite(MyTextFile);
480 Write(MyTextFile, 'set realmlist ' + servers[SeverIndex].Address);
481 CloseFile(MyTextFile);
482
483 ShellExecute(Handle, 'open', PChar(Servers[SeverIndex].ExeFile), nil, nil, SW_SHOWNORMAL);
484
485 If AfterWoWStartClose then
486 Close;
487 if AfterWoWStartMinimalize then
488 Application.Minimize;
489 except
490 raise Exception.Create('Nepodařilo se spustit hru pro připojení k serveru ' + Servers[SeverIndex].Name + '.');
491 end;
492end;
493
494procedure TForm1.ListView1DblClick(Sender: TObject);
495begin
496 if Assigned(ListView1.Selected) then begin
497 if CopyFonts then
498 CopyFontsProcedure(ListView1.Selected.Index);
499 ConnectSever(ListView1.Selected.Index);
500 end;
501end;
502
503procedure TForm1.Pidat1Click(Sender: TObject);
504var
505 BitMap: TBitmap;
506begin
507 Form4.Show;
508 ServerIndex := -1;
509 Form4.Edit3.Text := GetWoWExeFile;
510 BitMap := TBitmap.Create;
511 ImageList32default.GetBitmap(0, BitMap);
512 Form4.Image1.Picture.Graphic.Assign(BitMap);
513 BitMap.Free;
514end;
515
516function TForm1.GetWoWExeFile: string;
517var
518 Reg: TRegistry;
519begin
520 Reg := TRegistry.Create(KEY_READ);
521 try
522 Reg.RootKey := HKEY_LOCAL_MACHINE;
523 if Reg.OpenKey('\SOFTWARE\Blizzard Entertainment\World of Warcraft', False) then begin
524 Result := Reg.ReadString('GamePath');
525 end;
526 finally
527 Reg.Free;
528 end;
529end;
530
531procedure TForm1.WriteImages;
532var
533 BitMap : TBitmap;
534 BitMap2: TBitmap;
535 i: Integer;
536begin
537 //vypsání obrázků
538 ImageList16.Clear;
539 ImageList32.Clear;
540 for i := 0 to High(Servers) do begin
541 BitMap := TBitmap.Create;
542 BitMap2 := TBitmap.Create;
543
544 if (Servers[i].Image = '') or (FileExists(Servers[i].Image) = False) or (Servers[i].Image = '1') then begin
545 if Servers[i].Image = '1' then begin
546 ImageList16.AddImage(ImageList16default,1);
547 ImageList32.AddImage(ImageList32default,1);
548 end else begin
549 ImageList16.AddImage(ImageList16default,0);
550 ImageList32.AddImage(ImageList32default,0);
551 end;
552 // Servers[i].Image := ExtractFileDir(Application.ExeName)+'\'+ImageWoW;
553 end else begin
554 if GetTypeFile(Servers[i].Image) = 'bmp' then begin
555 if FileExists(Servers[i].Image) then begin
556 BitMap.LoadFromFile(Servers[i].Image);
557 ResizeBitmap(BitMap, BitMap2, 32, 32);
558 ImageList32.Add(BitMap2, nil);
559 ResizeBitmap(BitMap2,BitMap, 16, 16);
560 ImageList16.Add(BitMap, nil);
561 end;
562 end else begin //todo dodělat pro ikony
563 end;
564 end;
565 Bitmap.Free;
566 Bitmap2.Free;
567 end;
568end;
569
570procedure TForm1.Editovatoznaen1Click(Sender: TObject);
571var
572 BitMap: TBitmap;
573begin
574 //todo podmínka označení
575 if Assigned(ListView1.Selected) then begin
576 Form4.Show;
577 Form4.Edit1.Text := Servers[ListView1.Selected.Index].Name;
578 Form4.Edit2.Text := Servers[ListView1.Selected.Index].Address;
579 Form4.Edit3.Text := Servers[ListView1.Selected.Index].ExeFile;
580 Form4.Edit4.Text := Servers[ListView1.Selected.Index].OnlinePlayersAddress;
581 Form4.Memo1.Text := Servers[ListView1.Selected.Index].Description;
582 ImageFile := Servers[ListView1.Selected.Index].Image;
583 ServerIndex := ListView1.Selected.Index;
584 if ImageFile <> '' then begin
585 if ImageFile = '1' then begin
586 BitMap := TBitmap.Create;
587 ImageList32default.GetBitmap(1, BitMap);
588 Form4.Image1.Picture.Graphic.Assign(BitMap);
589 BitMap.Free;
590 end else begin
591 if FileExists(ImageFile) then begin
592 Form4.Image1.Picture.LoadFromFile(ImageFile);
593 end;
594 end;
595 end else begin
596 BitMap := TBitmap.Create;
597 Form1.ImageList32default.GetBitmap(0,BitMap);
598 Form4.Image1.Picture.Graphic.Assign(Bitmap);
599 BitMap.Free;
600 end;
601 end;
602end;
603
604procedure TForm1.Vymazatoznaen1Click(Sender: TObject);
605var
606 i: integer;
607begin
608 if Assigned(ListView1.Selected) then begin
609 for i:=0 to High(servers) do begin
610 if i > ListView1.Selected.Index then begin
611 Servers[i-1].Name := Servers[i].Name;
612 Servers[i-1].Address := Servers[i].Address;
613 Servers[i-1].ExeFile := Servers[i].ExeFile;
614 Servers[i-1].Image := Servers[i].Image;
615 Servers[i-1].Description := Servers[i].Description;
616 Servers[i-1].OnlinePlayersAddress := Servers[i].OnlinePlayersAddress;
617 end;
618 end;
619 SetLength(Servers,Length(Servers)-1);
620 WriteImages;
621 WriteServers;
622 end;
623 Form1.StatusBar1.SimpleText := 'Server byl smazán';
624end;
625
626procedure TForm1.Vymazatvechny1Click(Sender: TObject);
627begin
628 If ReallyYes('Smazat všechny servery?') then begin
629 SetLength(Servers, 0);
630 WriteImages;
631 WriteServers;
632 Form1.StatusBar1.SimpleText := 'Servery byly smazány';
633 end;
634end;
635
636procedure TForm1.LoadRegOptions;
637var
638 reg: TRegistry;
639 i: integer;
640begin
641 Reg := TRegistry.Create;
642 try
643 // načítání pozice formuláře
644 if Reg.OpenKey(R+'Form', False) then begin
645 Top := Reg.ReadInteger('Top');
646 Left := Reg.ReadInteger('Left');
647 Height := Reg.ReadInteger('Height');
648 Width := Reg.ReadInteger('Width');
649 if Reg.ReadBool('Maximized') then
650 WindowState := wsMaximized
651 else
652 WindowState := wsNormal;
653 end;
654 //načítání nastavení
655 if Reg.OpenKey(R+'CheckBox4', False) then begin
656 AfterWoWStartClose := Reg.ReadBool('Boolean');
657 end;
658 if Reg.OpenKey(R+'AfterWoWStartMinimalize', False) then begin
659 AfterWoWStartMinimalize := Reg.ReadBool('AfterWoWStartMinimalize');
660 end;
661 if Reg.OpenKey(R+'CheckBox5', False) then begin
662 UpdateApplication := Reg.ReadBool('Boolean');
663 end;
664 if Reg.OpenKey(R+'CheckBox6', False) then begin
665 StartMinimalize := Reg.ReadBool('Boolean');
666 end;
667 if Reg.OpenKey(R+'CheckBox7', False) then begin
668 CoolTrayIcon1.MinimizeToTray := Reg.ReadBool('Boolean');
669 end;
670 if Reg.OpenKey(R+'CheckBox12', False) then begin
671 OnCloseMinimalize := Reg.ReadBool('OnCloseMinimalize');
672 end;
673 if Reg.OpenKey(R+'CheckBox17', False) then begin
674 CopyFonts := Reg.ReadBool('CopyFonts');
675 end;
676
677 //aktuality nastavení
678 if Reg.OpenKey(R+'OptionsNews', False) then begin
679 Timer1.Enabled := Reg.ReadBool('DownloadNews');
680 Timer1.Interval := Reg.ReadInteger('NewsInterval');
681 SoundAfterNewNews := Reg.ReadBool('Beep');
682 ShowBalloonHint := Reg.ReadBool('ShowBallooHint');
683 ShowDetails := Reg.ReadBool('ShowDetails');
684 if reg.ValueExists('RSSAddress') then RSSAddress := Reg.ReadString('RSSAddress');
685 if RSSAddress = OldRSSChannel then RSSAddress := DefaultRSSChannel; // Přesměrování na novou adresu RSS
686
687 if reg.ValueExists('Ping') then Timer4.Enabled := Reg.ReadBool('Ping');
688 end;
689
690 //Online players Nastavení
691 if Reg.OpenKey(R+'OptionsOnlinePlayers', False) then begin
692 Timer2.Enabled := Reg.ReadBool('DownloadOnlinePlayers');
693 Timer2.Interval := Reg.ReadInteger('OnlinePlayersInterval');
694 end;
695
696 //skiny
697 if Reg.OpenKey(R+'CheckBox3', False) then begin
698 //SkinData1.Active := Reg.ReadBool('Boolean');
699 end;
700 if Reg.OpenKey(R+'skiny', False) then begin
701 if reg.ValueExists('skiny') then begin
702 //SkinData1.SkinFile := Reg.ReadString('Skiny');
703 end else
704 //SkinData1.Active := False;
705 end;
706
707 //načítání velikosti panelů a zobrazení
708 if Reg.OpenKey(R+'display', False) then begin
709 i := Reg.ReadInteger('ViewStyle');
710 case i of
711 1: ListView1.ViewStyle := vsIcon;
712 2: ListView1.ViewStyle := vsList;
713 3: ListView1.ViewStyle := vsReport;
714 4: ListView1.ViewStyle := vsSmallIcon;
715 end;
716 ListView1.Columns[0].Width := Reg.ReadInteger('Columns0Width');
717 ListView1.Columns[1].Width := Reg.ReadInteger('Columns1Width');
718 ListView1.Columns[2].Width := Reg.ReadInteger('Columns2Width');
719 if reg.ValueExists('PanelLeft') then Panel2.Left := Reg.ReadInteger('PanelLeft')
720 else ShowDetails := False;
721 DrawForm;
722 end;
723
724 if Reg.OpenKey(R+'dock', False) then begin
725 DockingNews := reg.ReadBool('DockingNews');
726 DockingOnlinePlayers := reg.ReadBool('DockingOnlinePlayers');
727 Aktuality1.Checked := reg.ReadBool('ShowNews');
728 OnlineHri1.Checked := reg.ReadBool('ShowOnlinePlayers');
729 end;
730 finally
731 Reg.Free;
732 end;
733end;
734
735procedure TForm1.ResizeBitmap(const Source: TBitmap; var Target: TBitmap;
736 NewWidth, NewHeight: Integer);
737var
738 TargetIsSource: Boolean;
739 pt: TPoint;
740 StretchBltMode: Integer;
741begin
742 TargetIsSource := Target = Source;
743 if (Target = nil) or (TargetIsSource) then
744 begin
745 Target := TBitmap.Create;
746 Target.PixelFormat := Source.PixelFormat;
747 end;
748 Target.Width := NewWidth;
749 Target.Height := NewHeight;
750
751 StretchBltMode := GetStretchBltMode(Target.Canvas.Handle);
752 SetStretchBltMode(Target.Canvas.Handle, HALFTONE); // bessere Ergebnisse beim Stretchen
753 SetBrushOrgEx(Target.Canvas.Handle, 0, 0, @pt); // muss nach SetStretchBltMode aufgerufen werden
754
755 StretchBlt(Target.Canvas.Handle, 0, 0, Target.Width, Target.Height,
756 Source.Canvas.Handle, 0, 0, Source.Width, Source.Height, SRCCOPY);
757
758 // zurücksetzen
759 SetStretchBltMode(Target.Canvas.Handle, StretchBltMode);
760 SetBrushOrgEx(Target.Canvas.Handle, pt.X, pt.Y, nil);
761
762 if TargetIsSource then
763 begin
764 // wiederherstellen
765 Source.Assign(Target);
766 Target.Free;
767 Target := Source;
768 end;
769end;
770
771function TForm1.GetTypeFile(SourceFile: string): string;
772var
773 Data: string;
774begin
775 Data := SourceFile;
776 delete(Data,1,length(SourceFile)-3);
777 Result := Data;
778end;
779
780procedure TForm1.SaveRegOptions;
781var
782 reg: TRegistry;
783 i: integer;
784begin
785 Reg := TRegistry.Create(KEY_WRITE);
786 try
787 Reg.RootKey := HKEY_CURRENT_USER;
788 // uložení pozice formuláře
789 if Reg.OpenKey(R+'Form', True) then begin
790 Reg.WriteInteger('Top', Top);
791 Reg.WriteInteger('Left', Left);
792 Reg.WriteInteger('Height', Height);
793 Reg.WriteInteger('Width', Width);
794 Reg.WriteBool('Maximized', WindowState = wsMaximized);
795 end;
796
797 //ukládání nastavení
798 if Reg.OpenKey(R+'CheckBox4', True) then begin
799 Reg.WriteBool('Boolean',AfterWoWStartClose);
800 end;
801 if Reg.OpenKey(R+'AfterWoWStartMinimalize', True) then begin
802 Reg.WriteBool('AfterWoWStartMinimalize',AfterWoWStartMinimalize);
803 end;
804 if Reg.OpenKey(R+'CheckBox5', True) then begin
805 Reg.WriteBool('Boolean',UpdateApplication);
806 end;
807 if Reg.OpenKey(R+'CheckBox6', True) then begin
808 Reg.WriteBool('Boolean',StartMinimalize);
809 end;
810 if Reg.OpenKey(R+'CheckBox7', True) then begin
811 Reg.WriteBool('Boolean',CoolTrayIcon1.MinimizeToTray);
812 end;
813 if Reg.OpenKey(R+'CheckBox12', True) then begin
814 Reg.WriteBool('OnCloseMinimalize',OnCloseMinimalize);
815 end;
816 if Reg.OpenKey(R+'CheckBox17', True) then begin
817 Reg.WriteBool('CopyFonts',CopyFonts);
818 end;
819
820 //aktuality nastavení
821 if Reg.OpenKey(R+'OptionsNews', True) then begin
822 reg.WriteBool('DownloadNews',Timer1.Enabled);
823 reg.WriteBool('Beep',SoundAfterNewNews);
824 reg.WriteBool('ShowBallooHint',ShowBalloonHint);
825 reg.WriteInteger('NewsInterval',Timer1.Interval);
826 reg.WriteBool('ShowDetails',ShowDetails);
827 reg.WriteString('RSSAddress',RSSAddress);
828 Reg.WriteBool('Ping',Form1.Timer4.Enabled);
829 end;
830
831 //Online Players nastavení
832 if Reg.OpenKey(R+'OptionsOnlinePlayers', True) then begin
833 reg.WriteBool('DownloadOnlinePlayers',Timer2.Enabled);
834 reg.WriteInteger('OnlinePlayersInterval',Timer2.Interval);
835 end;
836
837
838 //skiny
839 if Reg.OpenKey(R+'CheckBox3', True) then begin
840 //Reg.WriteBool('Boolean',SkinData1.Active);
841 end;
842 if Reg.OpenKey(R+'skiny', True) then begin
843 //Reg.WriteString('Skiny',SkinData1.SkinFile);
844 end;
845
846 //ukládání velikosti panelů a zobrazení
847 if Reg.OpenKey(R+'display', True) then begin
848 i := 1;
849 if ListView1.ViewStyle = vsIcon then
850 i := 1;
851 if ListView1.ViewStyle = vsList then
852 i := 2;
853 if ListView1.ViewStyle = vsReport then
854 i := 3;
855 if ListView1.ViewStyle = vsSmallIcon then
856 i := 4;
857
858 Reg.WriteInteger('ViewStyle',i);
859
860 Reg.WriteInteger('Columns0Width',ListView1.Columns[0].Width);
861 Reg.WriteInteger('Columns1Width',ListView1.Columns[1].Width);
862 Reg.WriteInteger('Columns2Width',ListView1.Columns[2].Width);
863
864 Reg.WriteInteger('PanelLeft',Panel2.Left);
865 end;
866
867 if Reg.OpenKey(R+'dock', True) then begin
868 reg.WriteBool('DockingOnlinePlayers',DockingOnlinePlayers);
869 reg.WriteBool('DockingNews',DockingNews);
870 reg.WriteBool('ShowNews',Aktuality1.Checked);
871 reg.WriteBool('ShowOnlinePlayers',OnlineHri1.Checked);
872 end;
873 finally
874 Reg.Free;
875 end;
876end;
877
878procedure TForm1.SaveRegServers;
879var
880 reg: TRegistry;
881 i: Integer;
882begin
883 Reg := TRegistry.Create;
884 try
885 Reg.RootKey := HKEY_CURRENT_USER;
886
887 // Uložení seznamu serverů
888 for i := 0 to High(servers) do
889 if Reg.OpenKey(R+'Listview'+IntToStr(i), True) then
890 with Servers[I] do begin
891 Reg.WriteString('name', Name);
892 Reg.WriteString('server',Address);
893 Reg.WriteString('file',ExeFile);
894 Reg.WriteString('image',Image);
895 Reg.WriteString('description',Description);
896 Reg.WriteString('OnlinePlayersAddress',OnlinePlayersAddress);
897 end;
898 if Reg.OpenKey(R, True) then
899 Reg.WriteInteger('počet',length (servers));
900
901 finally
902 Reg.Free;
903 end;
904end;
905
906procedure TForm1.WMMoving(var Message: TWMMoving);
907var
908 OriginalWidth, OriginalHeight: integer;
909begin
910 OriginalWidth := Width;
911 OriginalHeight := Height;
912 if (WindowState = wsNormal) and Visible then
913 begin
914 if (Message.Coord.Left < (Desktop.Left + 10)) then Message.Coord.Left := Desktop.Left;
915 if (Message.Coord.Top < (Desktop.Top + 10)) then Message.Coord.Top := Desktop.Top;
916 if (Message.Coord.Bottom > (Desktop.Bottom - 10)) then Message.Coord.Top := Desktop.Bottom - Height;
917 if (Message.Coord.Right > (Desktop.Right - 10)) then Message.Coord.Left := Desktop.Right - Width;
918 end;
919 Message.Coord.Right := Message.Coord.Left + OriginalWidth;
920 Message.Coord.Bottom := Message.Coord.Top + OriginalHeight;
921
922 //přichycení formulářů
923 If DockingOnlinePlayers then begin
924 Form5.Left := Form5.Left+(-Form1.Left-Form1.Width+Message.Coord.Right);
925 Form5.Top := Form5.Top+(-Form1.Top-Form1.Height+Message.Coord.Bottom);
926 end;
927 If DockingNews then begin
928 Form6.Left := Form6.Left+(-Form1.Left-Form1.Width+Message.Coord.Right);
929 Form6.Top := Form6.Top+(-Form1.Top-Form1.Height+Message.Coord.Bottom);
930 end;
931end;
932
933procedure TForm1.OnlineHri1Click(Sender: TObject);
934begin
935 ShowOnlinePlayers;
936end;
937
938procedure TForm1.Aktuality1Click(Sender: TObject);
939begin
940 ShowNews;
941end;
942
943procedure TForm1.Panel2MouseUp(Sender: TObject; Button: TMouseButton;
944 Shift: TShiftState; X, Y: Integer);
945begin
946 DragDown := false;
947end;
948
949procedure TForm1.ShowOnlinePlayers;
950begin
951 if OnlineHri1.Checked then begin
952 Form5.Close;
953 OnlineHri1.Checked := False;
954 end else begin
955 Form5.Show;
956 OnlineHri1.Checked := True;
957 end;
958end;
959
960procedure TForm1.ShowNews;
961begin
962 if Aktuality1.Checked then begin
963 Form6.Close;
964 Aktuality1.Checked := False;
965 end else begin
966 Form6.Show;
967 Aktuality1.Checked := True;
968 end;
969end;
970
971procedure TForm1.Timer1Timer(Sender: TObject);
972begin
973 Form6.DownloadRSS;
974 Form6.WriteNews;
975end;
976
977procedure TForm1.ListView1MouseMove(Sender: TObject; Shift: TShiftState; X,
978 Y: Integer);
979begin
980if ShowDetails then begin
981 if Assigned(ListView1.GetItemAt(x,y)) then begin
982 if Form7.Showing then begin
983 if DetailsServerIndex <> ListView1.GetItemAt(x,y).Index then begin
984 DrawDetail;
985 end;
986 end else begin
987 Timer3.Enabled := True;
988 end;
989 end else begin
990 Timer3.Enabled := False;
991 if Form7.Showing then
992 Form7.Close;
993 end;
994end;
995end;
996
997procedure TForm1.Timer2Timer(Sender: TObject);
998begin
999 Form5.DownloadPlayers;
1000end;
1001
1002procedure TForm1.ListView1SelectItem(Sender: TObject; Item: TListItem;
1003 Selected: Boolean);
1004begin
1005 //online hráči
1006 if LockOnlineAddres = False then begin
1007 if Assigned(ListView1.Selected) and OnlineHri1.Checked then begin
1008 OnlinePlayersIndex := ListView1.Selected.Index;
1009 Form5.DownloadPlayers;
1010 end;
1011 end;
1012 //detajly
1013 if Assigned(ListView1.Selected) then begin
1014 RichEdit1.Text := Form1.Servers[ListView1.Selected.index].Description;
1015 Label1.Caption := Form1.Servers[ListView1.Selected.index].Name;
1016 if Form1.Timer4.Enabled then begin
1017 Label2.Font.Color := clRed;
1018 Label2.Caption := 'Čekám na odezvu';
1019 Button1.Enabled := True;
1020
1021 if Form1.Servers[ListView1.Selected.index].Address <> '' then begin
1022 if Form1.IdIcmpClient1.Host <> Form1.Servers[Form1.ListView1.Selected.index].Address then
1023 // if vlakno.Suspended = True then vlakno.Suspend;
1024 Form1.IdIcmpClient1.Host := Form1.Servers[Form1.ListView1.Selected.index].Address;
1025 // Vlakno.Execute;
1026 end else begin
1027 Label2.Font.Color := clRed;
1028 Label2.Caption := 'Není Adresa';
1029 end;
1030 end else begin
1031 Label2.Caption := '';
1032 end;
1033 end; //TODO - při neoznačeném vymazat detajly
1034 // vlakno.Free;
1035end;
1036
1037procedure TForm1.PidatHeroesofFantasy1Click(Sender: TObject);
1038begin
1039 SetLength(Servers,length(Servers)+1);
1040 with Servers[length(Servers) - 1] do begin
1041 Name := 'Heroes of Fantasy';
1042 Address := HoFRealmList;
1043 OnlinePlayersAddress := HoFOnlineListURL;
1044 ExeFile := GetWoWExeFile;
1045 Image := '1';
1046 Description := 'Heroes of Fantasy - Free server'#13#10' 2x XP'#13#10'web: http://' + HoFWeb + '/'#13#10'realmlist: ' + HoFRealmList;
1047 end;
1048 WriteImages;
1049 WriteServers;
1050 Form1.StatusBar1.SimpleText := 'Heroes of Fantasy byl přidán';
1051end;
1052
1053procedure TForm1.FinalyClose;
1054begin
1055 SaveRegOptions;
1056 SaveRegServers;
1057
1058 // aktuality
1059 Form6.SaveRegRSS;
1060 Form6.SaveRegNewsOptions;
1061
1062 //online hráči
1063 Form5.SaveRegOptions;
1064end;
1065
1066procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
1067begin
1068 if OnCloseMinimalize then begin
1069 CanClose := False;
1070 Application.Minimize;
1071 end else begin
1072 CanClose := True;
1073 FinalyClose;
1074 end;
1075end;
1076
1077procedure TForm1.Timer3Timer(Sender: TObject);
1078begin
1079 DrawDetail;
1080 Timer3.Enabled := false;
1081end;
1082
1083procedure TForm1.DrawDetail;
1084var
1085 Position: TPoint;
1086 x,y: integer;
1087begin
1088 GetCursorPos(Position);
1089 x := Position.X-Form1.left - 6;
1090 y := Position.Y-Form1.top - 52;
1091 if Assigned(ListView1.GetItemAt(x,y)) then begin
1092 Form7.Left := Position.X;
1093 Form7.Top := Position.Y;
1094 DetailsServerIndex := ListView1.GetItemAt(x,y).Index;
1095 Form7.Show;
1096 Form7.FormShow(nil);
1097 end;
1098end;
1099
1100function TForm1.NeedUpdate: Boolean;
1101var
1102 NewVersion: string;
1103 NewVersionInt: integer;
1104begin
1105 try
1106 NewVersion := IdHTTP1.Get(UpdateInfoFile);
1107 NewVersion := StringReplace(NewVersion,chr(10),'',[rfReplaceAll]);
1108 NewVersion := StringReplace(NewVersion,chr(13),'',[rfReplaceAll]);
1109 // NewVersion := StringReplace(NewVersion,',','',[rfReplaceAll]);
1110 // NewVersion := StringReplace(NewVersion,'0','',[rfReplaceAll]);
1111 // nastavit na souboru na serveru 3 místo 3,0
1112 NewVersionInt := StrToInt(NewVersion);
1113 except
1114 StatusBar1.SimpleText := 'Chyba spojení se serverem';
1115 NewVersionInt := 0;
1116 end;
1117 if NewVersionInt > ApplicationRevision then begin
1118 Result := True;
1119 end else begin
1120 Result := False;
1121 end;
1122end;
1123
1124procedure TForm1.ProcedureUpdateApplication;
1125begin
1126 if ReallyYes('Chcete aktualizovat program?') then begin
1127 ShowWeb;
1128 end;
1129end;
1130
1131procedure TForm1.ShowWeb;
1132begin
1133 ShellExecute(Handle, 'open', PChar(ProjectHomepage), nil, nil, SW_SHOWNORMAL);
1134end;
1135
1136procedure TForm1.Zkontrolovatverziprogramu1Click(Sender: TObject);
1137begin
1138 if NeedUpdate then
1139 ProcedureUpdateApplication;
1140end;
1141
1142procedure TForm1.Npovda1Click(Sender: TObject);
1143begin
1144// ShowWeb;
1145 if FileExists(ExtractFileDir(Application.ExeName)+'\NÁPOVĚDA.HLP') then begin
1146 ShellExecute(Handle, 'open', PChar(ExtractFileDir(Application.ExeName)+'\NÁPOVĚDA.HLP'), nil, nil, SW_SHOWNORMAL);
1147 end else begin
1148 ShowMessage('Nápověda nenalezena!');
1149 StatusBar1.SimpleText := 'Nápověda nenalezena!';
1150 end;
1151end;
1152
1153procedure TForm1.ListView1KeyDown(Sender: TObject; var Key: Word;
1154 Shift: TShiftState);
1155begin
1156 if Key = 46 then begin
1157 Vymazatoznaen1Click(nil);
1158 end;
1159// StatusBar1.SimpleText := IntToStr(key);
1160end;
1161
1162procedure TForm1.Exportovatserver1Click(Sender: TObject);
1163var
1164 NewStock: IXMLNode;
1165 ValueNode: IXMLNode;
1166 XMLDoc : TXMLDocument;
1167begin
1168 if Assigned(ListView1.Selected) then begin
1169 SaveDialog1.Filter:= 'XML soubor|*.xml|Všechny soubory|*.*';
1170 SaveDialog1.FileName:= Servers[ListView1.Selected.Index].Name+'.xml';
1171 if SaveDialog1.Execute then begin
1172 XMLDoc := TXMLDocument.Create(nil);
1173 XMLDoc.Active := True;
1174 NewStock := XMLDoc.AddChild('server');
1175 ValueNode := NewStock.AddChild('servername');
1176 ValueNode.Text := Servers[ListView1.Selected.Index].Name;
1177 ValueNode := NewStock.AddChild('serveraddress');
1178 ValueNode.Text := Servers[ListView1.Selected.Index].Address;
1179 ValueNode := NewStock.AddChild('exefile');
1180 ValueNode.Text := Servers[ListView1.Selected.Index].ExeFile;
1181 ValueNode := NewStock.AddChild('image');
1182 ValueNode.Text := Servers[ListView1.Selected.Index].Image;
1183 ValueNode := NewStock.AddChild('description');
1184 ValueNode.Text := Servers[ListView1.Selected.Index].description;
1185 ValueNode := NewStock.AddChild('onlineplayersaddress');
1186 ValueNode.Text := Servers[ListView1.Selected.Index].onlineplayersaddress;
1187
1188 XMLDoc.SaveToFile(SaveDialog1.FileName);
1189
1190 { AssignFile(MyTextFile, SaveDialog1.FileName);
1191 Rewrite(MyTextFile);
1192 WriteLn(MyTextFile, '<?xml version="1.0" encoding="UTF-8"?>');
1193 WriteLn(MyTextFile, '<server>');
1194 WriteLn(MyTextFile, ' <servername>'+Servers[ListView1.Selected.Index].Name+'</servername>');
1195 WriteLn(MyTextFile, ' <serveraddress>'+Servers[ListView1.Selected.Index].Address+'</serveraddress>');
1196 WriteLn(MyTextFile, ' <exefile>'+Servers[ListView1.Selected.Index].ExeFile+'</exefile>');
1197 WriteLn(MyTextFile, ' <image>'+Servers[ListView1.Selected.Index].Image+'</image>');
1198 WriteLn(MyTextFile, ' <description>'+Servers[ListView1.Selected.Index].Description+'</description>');
1199 WriteLn(MyTextFile, ' <onlineplayersaddress>'+Servers[ListView1.Selected.Index].OnlinePlayersAddress+'</onlineplayersaddress>');
1200 WriteLn(MyTextFile, '</server>');
1201 CloseFile(MyTextFile); }
1202 end;
1203 StatusBar1.SimpleText := 'Soubor uložen';
1204 end;
1205
1206 {
1207<?xml version="1.0" encoding="UTF-8"?>
1208<!DOCTYPE server SYSTEM "http://www.heroesoffantasy.cz/projectonlineplayes/onlineplayers.dtd">
1209<server>
1210 <servername>Heroes Of Fantasy</servername>
1211 <serveraddress>www.heroesoffantasy.cz</serveraddress>
1212 <owner>Chronos</owner>
1213 <patch>2.13</patch>
1214 <uptime>0 weeks 1 days 0 hours 0 mins</uptime>
1215 <registration>Otevřeny</registration>
1216 <maxplayers>100</maxplayers>
1217 <xp>2x</xp>
1218 <players>
1219 <playerscount>2</playerscount>
1220 <player>
1221 <name>maron</name>
1222 <level>99</level>
1223 <race>2</race>
1224 <class>3</class>
1225 <zone>Elwynn Forest</zone>
1226 <map>Azeroths</map>
1227 <ping>10</ping>
1228 <ip>192.168.1.5</ip>
1229 <plevel>0</plevel>
1230 <honor>100</honor>
1231 </player>
1232 <player>
1233 <name>miko</name>
1234 <level>23</level>
1235 <race>3</race>
1236 <class>5</class>
1237 </player>
1238 </players>
1239</server>
1240}
1241
1242end;
1243
1244procedure TForm1.ExportovatdoXML1Click(Sender: TObject);
1245begin
1246 Exportovatserver1Click(nil);
1247end;
1248
1249procedure TForm1.Edit1Click(Sender: TObject);
1250begin
1251 Edit1.SelectAll;
1252end;
1253
1254procedure TForm1.Image1Click(Sender: TObject);
1255begin
1256//http://www.wowhead.com/?search=test
1257 OpenSearchURL('http://www.wowhead.com/?search=');
1258end;
1259
1260procedure TForm1.Image2Click(Sender: TObject);
1261begin
1262//http://wow.allakhazam.com/search.html?q=test
1263 OpenSearchURL('http://wow.allakhazam.com/search.html?q=');
1264end;
1265
1266procedure TForm1.Image3Click(Sender: TObject);
1267begin
1268//http://thottbot.com/?s=test
1269 OpenSearchURL('http://thottbot.com/?s=');
1270end;
1271
1272procedure TForm1.OpenSearchURL(URL: string);
1273begin
1274 ShellExecute(Handle, 'open', PChar(URL+Edit1.Text), nil, nil, SW_SHOWNORMAL);
1275end;
1276
1277procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
1278begin
1279 if Key = #13 then begin
1280 Key:= #0;
1281 Image4Click(nil);
1282 end;
1283end;
1284
1285procedure TForm1.ImportXMLfile;
1286var
1287 BitMap: TBitmap;
1288begin
1289 OpenDialog1.Filter:= 'XML soubor|*.xml|Všechny soubory|*.*';
1290 if OpenDialog1.Execute then begin
1291 try
1292 XMLDocument1.FileName := OpenDialog1.FileName;
1293 XMLDocument1.Active:=True;
1294
1295 // SetLength(Servers,length(Servers)+1);
1296
1297 if XMLDocument1.DocumentElement.ChildNodes['servername'].IsTextElement then
1298 Form4.Edit1.Text := XMLDocument1.DocumentElement.ChildNodes['servername'].Text;
1299 if XMLDocument1.DocumentElement.ChildNodes['serveraddress'].IsTextElement then
1300 Form4.Edit2.Text := XMLDocument1.DocumentElement.ChildNodes['serveraddress'].Text;
1301 if XMLDocument1.DocumentElement.ChildNodes['exefile'].IsTextElement then
1302 Form4.Edit3.Text := XMLDocument1.DocumentElement.ChildNodes['exefile'].Text
1303 else Form4.Edit3.Text := GetWoWExeFile;
1304 if XMLDocument1.DocumentElement.ChildNodes['onlineplayersaddress'].IsTextElement then
1305 Form4.Edit4.Text := XMLDocument1.DocumentElement.ChildNodes['onlineplayersaddress'].Text;
1306 if XMLDocument1.DocumentElement.ChildNodes['image'].IsTextElement then begin
1307 ImageFile := XMLDocument1.DocumentElement.ChildNodes['image'].Text;
1308 if ImageFile <> '' then begin
1309 if ImageFile = '1' then begin
1310 BitMap := TBitmap.Create;
1311 ImageList32default.GetBitmap(1,BitMap);
1312 Form4.Image1.Picture.Graphic := BitMap;
1313 end else begin
1314 if FileExists(ImageFile) then begin
1315 Form4.Image1.Picture.LoadFromFile(ImageFile);
1316 end;
1317 end;
1318 end else begin
1319 BitMap := TBitmap.Create;
1320 Form1.ImageList32default.GetBitmap(0,BitMap);
1321 Form4.Image1.Picture.Graphic := BitMap;
1322 end;
1323 // Form4.Image1.Picture.LoadFromFile(ImageFile);
1324 end else begin
1325 BitMap := TBitmap.Create;
1326 ImageList32default.GetBitmap(0,BitMap);
1327 Form4.Image1.Picture.Graphic := BitMap;
1328 end;
1329
1330
1331 if XMLDocument1.DocumentElement.ChildNodes['description'].IsTextElement then begin
1332 Form4.Memo1.Text := XMLDocument1.DocumentElement.ChildNodes['description'].Text;
1333 Form4.Memo1.Text := StringReplace(Form4.Memo1.Text,chr(10),chr(13)+chr(10),[rfReplaceAll]);
1334 end else begin
1335 if XMLDocument1.DocumentElement.ChildNodes['owner'].IsTextElement then
1336 Form4.Memo1.Text := 'Vlastník: '+XMLDocument1.DocumentElement.ChildNodes['owner'].Text;
1337 if XMLDocument1.DocumentElement.ChildNodes['maxplayers'].IsTextElement then
1338 Form4.Memo1.Text := Form4.Memo1.Text+chr(13)+chr(10)+'Maximální počet hráčů: '+XMLDocument1.DocumentElement.ChildNodes['maxplayers'].Text;
1339 if XMLDocument1.DocumentElement.ChildNodes['xp'].IsTextElement then
1340 Form4.Memo1.Text := Form4.Memo1.Text+chr(13)+chr(10)+'xprate: '+XMLDocument1.DocumentElement.ChildNodes['xp'].Text;
1341 if XMLDocument1.DocumentElement.ChildNodes['patch'].IsTextElement then
1342 Form4.Memo1.Text := Form4.Memo1.Text+chr(13)+chr(10)+'Verze patche při přidání serveru: '+XMLDocument1.DocumentElement.ChildNodes['patch'].Text;
1343 if XMLDocument1.DocumentElement.ChildNodes['registration'].IsTextElement then
1344 Form4.Memo1.Text := Form4.Memo1.Text+chr(13)+chr(10)+'Stav registrací při přidání serveru: '+XMLDocument1.DocumentElement.ChildNodes['registration'].Text;
1345 end;
1346
1347 // WriteImages;
1348 // WriteServers;
1349 // Form1.StatusBar1.SimpleText := 'Server z souboru XML přidán';
1350
1351 //zobrazení přidání serveru
1352 Form4.Show;
1353 ServerIndex := -1;
1354
1355 except
1356 On E : Exception do begin
1357 Form1.StatusBar1.SimpleText := 'Import z XML se nepovedl';
1358 end;
1359 end;
1360 end;
1361end;
1362
1363procedure TForm1.Importovatserver1Click(Sender: TObject);
1364begin
1365 ImportXMLfile;
1366end;
1367
1368procedure TForm1.PopupMenu2Popup(Sender: TObject);
1369begin
1370 Timer3.Enabled := False;
1371end;
1372
1373procedure TForm1.Importz1Click(Sender: TObject);
1374begin
1375 Form8.Caption := 'Import serverů z servery.wowresource.eu';
1376 Form8.LoadCountRegServers;
1377 Form9.Gauge1.MaxValue := CountWoWResourceServers;
1378 Form9.Show;
1379
1380 EndLoadingBool := False;
1381 Form8.ListView1.Clear;
1382 Form8.WriteServers('http://servery.wowresource.eu/index.php');
1383 // if EndLoadingBool = False then Form8.WriteServers('http://servery.wowresource.eu/index.php?p=2');
1384 Form9.Close;
1385
1386
1387 if EndLoadingBool = false then begin
1388 Form8.Show;
1389 //uložení počtu serverů
1390 CountWoWResourceServers := Form8.ListView1.Items.Count;
1391 Form8.SaveCountRegServers;
1392 end;
1393
1394 // Form8.Timer1.Enabled := true;
1395
1396end;
1397
1398procedure TForm1.MainMenu1Change(Sender: TObject; Source: TMenuItem;
1399 Rebuild: Boolean);
1400begin
1401 Timer3.Enabled := False;
1402
1403end;
1404
1405procedure TForm1.Image4Click(Sender: TObject);
1406begin
1407 OpenSearchURL(AoWoWSearchURL);
1408end;
1409
1410procedure TForm1.ListView1MouseDown(Sender: TObject; Button: TMouseButton;
1411 Shift: TShiftState; X, Y: Integer);
1412var
1413 MousePos: TPoint;
1414begin
1415 GetCursorPos(MousePos);
1416 if (Button = mbRight) and Assigned(ListView1.GetItemAt(x,y)) then begin
1417 PopupMenu2.Popup(MousePos.X,MousePos.y);
1418 end else begin
1419 if (Button = mbRight) then
1420 PopupMenu3.Popup(MousePos.X,MousePos.y);
1421 end;
1422end;
1423
1424procedure TForm1.Importzwowstatusnet1Click(Sender: TObject);
1425begin
1426 // http://wowstatus.net/serverlist.php
1427
1428 // Načtení počtu serverů
1429 Form8.Caption := 'Import serverů z WoWStatus.net';
1430 Form8.LoadCountRegServers;
1431 Form9.Gauge1.MaxValue := CountWoWStatusServers + 80;
1432 Form9.Show;
1433
1434 EndLoadingBool := False;
1435 Form8.ListView1.Clear;
1436 Form8.WriteServersWoWStatus('http://wowstatus.net/serverlist.php');
1437 Form9.Close;
1438
1439 if not EndLoadingBool then begin
1440 Form8.Show;
1441 // Uložení počtu serverů
1442 CountWoWStatusServers := Form8.ListView1.Items.Count;
1443 Form8.SaveCountRegServers;
1444 end;
1445 // Form8.Timer1.Enabled := true;
1446end;
1447
1448procedure TForm1.InitRichEditURLDetection(RE: TRichEdit);
1449var
1450 mask: Word;
1451begin
1452 mask := SendMessage(RE.Handle, EM_GETEVENTMASK, 0, 0);
1453 SendMessage(RE.Handle, EM_SETEVENTMASK, 0, mask or ENM_LINK);
1454 SendMessage(RE.Handle, EM_AUTOURLDETECT, Integer(True), 0);
1455end;
1456
1457procedure TForm1.WndProc(var Msg: TMessage);
1458var
1459 p: TENLink;
1460 sURL: string;
1461 CE : TRichEdit;
1462begin
1463 if (Msg.Msg = WM_NOTIFY) then
1464 begin
1465 if (PNMHDR(Msg.lParam).code = EN_LINK) then
1466 begin
1467 p := TENLink(Pointer(TWMNotify(Msg).NMHdr)^);
1468 if (p.Msg = WM_LBUTTONDOWN) then
1469 begin
1470 try
1471 CE := TRichEdit(Form1.ActiveControl);
1472 SendMessage(CE.Handle, EM_EXSETSEL, 0, Longint(@(p.chrg)));
1473 sURL := CE.SelText;
1474 ShellExecute(Handle, 'open', PChar(sURL), nil, nil, SW_SHOWNORMAL);
1475 except
1476 end;
1477 end;
1478 end;
1479 end;
1480
1481 inherited;
1482end;
1483
1484procedure TForm1.Panel2MouseDown(Sender: TObject; Button: TMouseButton;
1485 Shift: TShiftState; X, Y: Integer);
1486begin
1487 DragDown := true;
1488 GetCursorPos(StartPosition);
1489end;
1490
1491procedure TForm1.Panel2MouseMove(Sender: TObject; Shift: TShiftState; X,
1492 Y: Integer);
1493var
1494 Position: TPoint;
1495begin
1496 if DragDown then begin
1497 GetCursorPos(Position);
1498 if Position.x-Left-Panel2.Width < Width-30 then
1499 Panel2.Left := Position.x-Left-Panel2.Width
1500 else
1501 Panel2.Left := Width-17;
1502
1503 DrawForm;
1504 end;
1505end;
1506
1507procedure TForm1.DrawForm;
1508begin
1509 ListView1.Width := Panel2.Left;
1510 Label1.Left := Panel2.Left+Panel2.Width;
1511 Label2.Left := Panel2.Left+Panel2.Width;
1512 RichEdit1.Left := Panel2.Left+Panel2.Width;
1513 RichEdit1.Width := Form1.Width-Panel2.Left-Panel2.Width-8;
1514end;
1515
1516procedure TForm1.Button1Click(Sender: TObject);
1517begin
1518 if Assigned(ListView1.Selected) then
1519 ConnectSever(ListView1.Selected.Index);
1520end;
1521
1522procedure TForm1.IdIcmpClient1Reply(ASender: TComponent;
1523 const AReplyStatus: TReplyStatus);
1524begin
1525 if AReplyStatus.MsRoundTripTime > Cardinal(IdIcmpClient1.ReceiveTimeout) then begin
1526 Label2.Caption := 'Offline';
1527 Label2.Font.Color := clRed;
1528 end else begin
1529 Label2.Font.Color := clGreen;
1530 if AReplyStatus.MsRoundTripTime = 0 then
1531 Label2.Caption := 'Odezva: <1 ms'
1532 else
1533 Label2.Caption := 'Odezva: ' + IntToStr(AReplyStatus.MsRoundTripTime) + ' ms';
1534 end;
1535end;
1536
1537procedure TForm1.Timer4Timer(Sender: TObject);
1538begin
1539 Timer4.Interval := 4000;
1540 Vlakno.Free;
1541 Vlakno := TVlakno.Create(True);
1542 Vlakno.Resume;
1543 Vlakno.WaitFor;
1544end;
1545
1546procedure TForm1.FormResize(Sender: TObject);
1547begin
1548 DrawForm;
1549end;
1550
1551procedure TForm1.FormShow(Sender: TObject);
1552begin
1553 if OnlineHri1.Checked then Form5.Show;
1554 if Aktuality1.Checked then Form6.Show;
1555end;
1556
1557procedure TForm1.MediaPlay(MediaFile: string);
1558begin
1559 try
1560 Form1.MediaPlayer1.FileName := MediaFile;
1561 Form1.MediaPlayer1.Open;
1562 Form1.MediaPlayer1.Play;
1563 except
1564 Form1.StatusBar1.SimpleText := 'Soubor nelze přehrát';
1565 end;
1566end;
1567
1568function TForm1.ReallyYes(Text: string): Boolean;
1569begin
1570 Result := False;
1571 if MessageDlg(Text, mtConfirmation, [mbYes, mbNo], 0) = mrYes then
1572 Result := True;
1573end;
1574
1575procedure TForm1.Pidatrun1Click(Sender: TObject);
1576begin
1577 Pidat1Click(nil);
1578end;
1579
1580procedure TForm1.PidatHeroesofFantasy2Click(Sender: TObject);
1581begin
1582 PidatHeroesofFantasy1Click(nil);
1583end;
1584
1585procedure TForm1.ImportovatzXML1Click(Sender: TObject);
1586begin
1587 ImportXMLfile;
1588end;
1589
1590procedure TForm1.Importzserverywowresourceeu1Click(Sender: TObject);
1591begin
1592 Importz1Click(nil);
1593end;
1594
1595procedure TForm1.Importzwowstatusnet2Click(Sender: TObject);
1596begin
1597 Importzwowstatusnet1Click(nil);
1598end;
1599
1600procedure TForm1.CopyFontsProcedure(SeverIndex: integer);
1601var
1602 FontsOutDir: string;
1603 FontsDir: string;
1604begin
1605 FontsOutDir := ExtractFileDir(Servers[SeverIndex].ExeFile)+'\Data\Fonts\';
1606 FontsDir := ExtractFileDir(Application.ExeName)+'\Fonts\';
1607 if DirectoryExists(FontsDir) then begin
1608 if (DirectoryExists(FontsOutDir) = False) or FileExists(FontsOutDir+'FRIZQT__.ttf') = False
1609 or FileExists(FontsOutDir+'MORPHEUS.ttf') = False or FileExists(FontsOutDir+'SKURRI.ttf') = False
1610 or FileExists(FontsOutDir+'Info.txt') = False then begin
1611 CreateDir(FontsOutDir);
1612 CopyFiles(FontsDir+'FRIZQT__.ttf',FontsOutDir+'FRIZQT__.ttf');
1613 CopyFiles(FontsDir+'MORPHEUS.ttf',FontsOutDir+'MORPHEUS.ttf');
1614 CopyFiles(FontsDir+'SKURRI.ttf',FontsOutDir+'SKURRI.ttf');
1615 CopyFiles(FontsDir+'Info.txt',FontsOutDir+'Info.txt');
1616 StatusBar1.SimpleText := 'Fonty zkopírovány';
1617 end;
1618 end else StatusBar1.SimpleText := 'Zdrojové fonty nenalezeny';
1619end;
1620
1621procedure TForm1.CopyFiles(Source, Destination : string);
1622var
1623 FromF,
1624 ToF : file of byte;
1625 Buffer : array[0..4096] of char;
1626 NumRead : integer;
1627 FileLength : longint;
1628begin
1629 AssignFile(FromF,Source);
1630 reset(FromF);
1631 AssignFile(ToF,Destination);
1632 rewrite(ToF);
1633 FileLength:=FileSize(FromF);
1634 while FileLength > 0 do begin
1635 BlockRead(FromF,Buffer[0],SizeOf(Buffer),NumRead);
1636 FileLength := FileLength - NumRead;
1637 BlockWrite(ToF,Buffer[0],NumRead);
1638 end;
1639 CloseFile(FromF);
1640 CloseFile(ToF);
1641end;
1642
1643procedure TForm1.Zkoprovatfonty1Click(Sender: TObject);
1644var
1645 FontsOutDir: string;
1646 FontsDir: string;
1647begin
1648 if Assigned(ListView1.Selected) then begin
1649 FontsOutDir := ExtractFileDir(Servers[ListView1.Selected.Index].ExeFile)+'\Data\Fonts\';
1650 FontsDir := ExtractFileDir(Application.ExeName)+'\Fonts\';
1651 if (DirectoryExists(FontsOutDir) = False) or FileExists(FontsOutDir+'FRIZQT__.ttf') = False
1652 or FileExists(FontsOutDir+'MORPHEUS.ttf') = False or FileExists(FontsOutDir+'SKURRI.ttf') = False
1653 or FileExists(FontsOutDir+'Info.txt') = False then else
1654 StatusBar1.SimpleText := 'Složka wow již fonty obsahuje';
1655 CopyFontsProcedure(ListView1.Selected.Index);
1656 end;
1657end;
1658
1659{ TVlakno }
1660
1661procedure TVlakno.Execute;
1662begin
1663 if Form1.IdIcmpClient1.Host <> '' then
1664 try
1665 Form1.IdIcmpClient1.Ping;
1666 except
1667 Synchronize(Update);
1668 end;
1669end;
1670
1671procedure TVlakno.Update;
1672begin
1673 Form1.Label2.Caption := 'Offline';
1674 Form1.Label2.Font.Color := clRed;
1675end;
1676
1677end.
Note: See TracBrowser for help on using the repository browser.