source: branches/lazarus/Main.pas

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