Changeset 4 for Main.pas


Ignore:
Timestamp:
May 15, 2009, 9:08:00 AM (16 years ago)
Author:
george
Message:
  • Upraveno: Nyní určeno pro novější verzi Delphi zdarma Turbo Delphi.
  • Opraveno: Odkaz na RSS kanál aktualit webu.
  • Opraveno: Odkaz na web projektu.
  • Opraveno: Chyby uvolňování paměti při práci s bitmapami. Použití Assign namísto := a následně Free.
  • Upraveno: Zakomentovány odkazy na uzavřenou komponentu WinSkin. Nejsou dostupné zdrojové kódy, nelze doinstalovat správně do Turbo Delphi.
File:
1 edited

Legend:

Unmodified
Added
Removed

  • Main.pas

    r2 r4  
    66  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
    77  Dialogs, StdCtrls, Menus, ImgList, ComCtrls, XPMan, CoolTrayIcon, Registry, ShellApi,
    8   WinSkinData, ExtCtrls, xmldom, XMLIntf, msxmldom, XMLDoc,
     8  //WinSkinData,
     9  ExtCtrls, xmldom, XMLIntf, msxmldom, XMLDoc,
    910  IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP, RichEdit,
    1011  IdRawBase, IdRawClient, IdIcmpClient, MPlayer;
     12
     13const
     14  ApplicationVersion = '3.3';
     15  ApplicationRevision = 5;
     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';
    1120
    1221type
    … …  
    2332  protected
    2433    procedure Execute; override;
    25   end;
    26 
    27 type
     34    procedure Update;
     35  end;
     36
     37  TServer = record
     38    Name: string;
     39    Address: string;
     40    ExeFile: string;
     41    Image: string;
     42    Description: string;
     43    OnlinePlayersAddress: string;
     44  end;
     45
    2846  TForm1 = class(TForm)
    2947    MainMenu1: TMainMenu;
    … …  
    5674    Editovatoznaen2: TMenuItem;
    5775    Smazat1: TMenuItem;
    58     SkinData1: TSkinData;
    5976    ImageList16default: TImageList;
    6077    ImageList32default: TImageList;
    … …  
    165182    procedure Importzwowstatusnet2Click(Sender: TObject);
    166183    procedure Zkoprovatfonty1Click(Sender: TObject);
     184    procedure FormDestroy(Sender: TObject);
    167185  private
    168186    { Private declarations }
    … …  
    177195
    178196    // veřejné proměné
    179     Servers: array of record
    180       Name: string;
    181       Address: string;
    182       ExeFile: string;
    183       Image: string;
    184       Description: string;
    185       OnlinePlayersAddress: string;
    186     end;
     197    Servers: array of TServer;
    187198
    188199    //obecné procedury
    … …  
    217228  end;
    218229
    219 const
    220   ApplicationVersion = '3.2';
    221   ApplicationRevision = 5;
    222   R = '\Software\maronsoft\Heroes of Fantasy client pack\';
    223   UpdateInfoFile = 'http://wow.zdechov.net/client/aktualizace.txt';
    224 
    225230var
    226231  Form1: TForm1;
    … …  
    235240  ShowDetails: Boolean = False;
    236241 // MakePing: boolean = True;
    237   RSSAddress: string = 'http://wow.zdechov.net/rss.php';
     242  RSSAddress: string;
    238243  CopyFonts: Boolean = True;
    239244
    … …  
    247252  Desktop: TRect;
    248253
    249   // veřejné přoměné
    250   vlakno: TVlakno;
     254  Vlakno: TVlakno;
    251255
    252256implementation
    … …  
    361365procedure TForm1.FormCreate(Sender: TObject);
    362366begin
    363   //Načítání nastavení a vypsání
     367  Vlakno := TVlakno.Create(True);
     368
     369  // Načítání nastavení a vypsání
    364370  LoadRegOptions;
    365371  LoadRegServers;
    … …  
    367373  WriteServers;
    368374
    369   //Akce na záhladě nastavení
     375  // Akce na záhladě nastavení
    370376  if StartMinimalize then
    371377    Application.ShowMainForm := False;
    372378
    373   //ostatní
     379  // ostatní
    374380  Form1.Caption := Form1.Caption+' '+ApplicationVersion;
    375381  SystemParametersInfo(SPI_GETWORKAREA, 0, @Desktop, 0);
    376382  InitRichEditURLDetection(RichEdit1);
    377383
    378   //zjištění aktualizace
     384  // zjištění aktualizace
    379385  if UpdateApplication then
    380386    if NeedUpdate then
    381387      ProcedureUpdateApplication;
     388end;
     389
     390procedure TForm1.FormDestroy(Sender: TObject);
     391begin
     392  Vlakno.WaitFor;
     393  Vlakno.Free;
    382394end;
    383395
    … …  
    450462  MyTextFile: TextFile;
    451463begin
     464  try
    452465    AssignFile(MyTextFile, ExtractFileDir(Servers[SeverIndex].ExeFile)+'\realmlist.wtf');
    453466    Rewrite(MyTextFile);
    … …  
    466479    if AfterWoWStartMinimalize then
    467480      Application.Minimize;
     481  except
     482    raise Exception.Create('Nepodařilo se spustit hru pro připojení k serveru ' + Servers[SeverIndex].Name + '.');
     483  end;
    468484end;
    469485
    … …  
    485501  Form4.Edit3.Text := GetWoWExeFile;
    486502  BitMap := TBitmap.Create;
    487   ImageList32default.GetBitmap(0,BitMap);
    488   Form4.Image1.Picture.Graphic := BitMap;
     503  ImageList32default.GetBitmap(0, BitMap);
     504  Form4.Image1.Picture.Graphic.Assign(BitMap);
     505  BitMap.Free;
    489506end;
    490507
    … …  
    530547        if FileExists(Servers[i].Image) then begin
    531548          BitMap.LoadFromFile(Servers[i].Image);
    532           ResizeBitmap(BitMap,BitMap2,32,32);
    533           ImageList32.Add(BitMap2,nil);
    534           ResizeBitmap(BitMap2,BitMap,16,16);
    535           ImageList16.Add(BitMap,nil);
     549          ResizeBitmap(BitMap, BitMap2, 32, 32);
     550          ImageList32.Add(BitMap2, nil);
     551          ResizeBitmap(BitMap2,BitMap, 16, 16);
     552          ImageList16.Add(BitMap, nil);
    536553        end;
    537554      end else begin                             //todo dodělat pro ikony
    538555      end;
    539556    end;
     557    Bitmap.Free;
     558    Bitmap2.Free;
    540559  end;
    541560end;
    … …  
    558577      if ImageFile = '1' then begin
    559578        BitMap := TBitmap.Create;
    560         ImageList32default.GetBitmap(1,BitMap);
    561         Form4.Image1.Picture.Graphic := BitMap;
     579        ImageList32default.GetBitmap(1, BitMap);
     580        Form4.Image1.Picture.Graphic.Assign(BitMap);
     581        BitMap.Free;
    562582      end else begin
    563583        if FileExists(ImageFile) then begin
    … …  
    568588        BitMap := TBitmap.Create;
    569589        Form1.ImageList32default.GetBitmap(0,BitMap);
    570         Form4.Image1.Picture.Graphic := BitMap;
     590        Form4.Image1.Picture.Graphic.Assign(Bitmap);
     591        BitMap.Free;
    571592    end;
    572593  end;
    … …  
    654675      ShowDetails := Reg.ReadBool('ShowDetails');
    655676      if reg.ValueExists('RSSAddress') then RSSAddress := Reg.ReadString('RSSAddress');
     677      if RSSAddress = OldRSSChannel then RSSAddress := DefaultRSSChannel; // Přesměrování na novou adresu RSS
     678     
    656679      if reg.ValueExists('Ping') then Timer4.Enabled := Reg.ReadBool('Ping');
    657680    end;
    … …  
    665688    //skiny
    666689    if Reg.OpenKey(R+'CheckBox3', False) then begin
    667       SkinData1.Active := Reg.ReadBool('Boolean');
     690      //SkinData1.Active := Reg.ReadBool('Boolean');
    668691    end;
    669692    if Reg.OpenKey(R+'skiny', False) then begin
    670693      if reg.ValueExists('skiny') then begin
    671         SkinData1.SkinFile := Reg.ReadString('Skiny');
     694        //SkinData1.SkinFile := Reg.ReadString('Skiny');
    672695      end else
    673         SkinData1.Active := False;
     696        //SkinData1.Active := False;
    674697    end;
    675698
    … …  
    807830    //skiny
    808831    if Reg.OpenKey(R+'CheckBox3', True) then begin
    809       Reg.WriteBool('Boolean',SkinData1.Active);
     832      //Reg.WriteBool('Boolean',SkinData1.Active);
    810833    end;
    811834    if Reg.OpenKey(R+'skiny', True) then begin
    812         Reg.WriteString('Skiny',SkinData1.SkinFile);
     835        //Reg.WriteString('Skiny',SkinData1.SkinFile);
    813836    end;
    814837
    … …  
    10071030begin
    10081031  SetLength(Servers,length(Servers)+1);
    1009 
    1010         Servers[length(Servers)-1].Name := 'Heroes of Fantasy';
    1011         Servers[length(Servers)-1].Address := 'wow.zdechov.net';
    1012         Servers[length(Servers)-1].OnlinePlayersAddress := 'http://wow.zdechov.net/stat/stat.xml';
    1013         Servers[length(Servers)-1].ExeFile := GetWoWExeFile;
    1014         Servers[length(Servers)-1].Image := '1';
    1015         Servers[length(Servers)-1].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)+'reamlist: wow.zdechov.net';
     1032  with Servers[length(Servers) - 1] do begin
     1033    Name := 'Heroes of Fantasy';
     1034    Address := 'wow.zdechov.net';
     1035    OnlinePlayersAddress := 'http://wow.zdechov.net/stat/stat.xml';
     1036    ExeFile := GetWoWExeFile;
     1037    Image := '1';
     1038    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';
     1039  end;
    10161040  WriteImages;
    10171041  WriteServers;
    … …  
    10991123procedure TForm1.ShowWeb;
    11001124begin
    1101   ShellExecute(Handle, 'open', PChar('http://wow.zdechov.net/client/'), nil, nil, SW_SHOWNORMAL);
     1125  ShellExecute(Handle, 'open', PChar('http://wow.zdechov.net/?page=client/'), nil, nil, SW_SHOWNORMAL);
    11021126end;
    11031127
    … …  
    14961520  const AReplyStatus: TReplyStatus);
    14971521begin
    1498     if AReplyStatus.MsRoundTripTime > IdIcmpClient1.ReceiveTimeout then begin
    1499       Label2.Caption := 'Ofline';
     1522    if AReplyStatus.MsRoundTripTime > Cardinal(IdIcmpClient1.ReceiveTimeout) then begin
     1523      Label2.Caption := 'Offline';
    15001524      Label2.Font.Color := clRed;
    15011525    end else begin
    … …  
    15041528        Label2.Caption := 'Odezva: <1 ms'
    15051529      else
    1506         Label2.Caption := 'Odezva: '+IntToStr(AReplyStatus.MsRoundTripTime)+'  ms';
    1507     end;
    1508 end;
    1509 
    1510 { TVlakno }
    1511 
    1512 procedure TVlakno.Execute;
    1513 begin
    1514   if Form1.IdIcmpClient1.Host <> '' then begin
    1515         try
    1516           Form1.IdIcmpClient1.Ping;
    1517         except
    1518           Form1.Label2.Caption := 'Ofline';
    1519           Form1.Label2.Font.Color := clRed;
    1520         end;
    1521   end;
     1530        Label2.Caption := 'Odezva: ' + IntToStr(AReplyStatus.MsRoundTripTime) + '  ms';
     1531    end;
    15221532end;
    15231533
    15241534procedure TForm1.Timer4Timer(Sender: TObject);
    15251535begin
    1526          // vlakno.Terminate;
    15271536  Timer4.Interval := 4000;
    1528   Vlakno := TVlakno.Create(true);
    1529   vlakno.Resume;
    1530          // vlakno.Execute;
    1531 
     1537  Vlakno.Free;
     1538  Vlakno := TVlakno.Create(True);
     1539  Vlakno.Resume;
     1540  Vlakno.WaitFor;
    15321541end;
    15331542
    … …  
    16391648end;
    16401649
     1650{ TVlakno }
     1651
     1652procedure TVlakno.Execute;
     1653begin
     1654  if Form1.IdIcmpClient1.Host <> '' then
     1655    try
     1656      Form1.IdIcmpClient1.Ping;
     1657    except
     1658      Synchronize(Update);
     1659    end;
     1660end;
     1661
     1662procedure TVlakno.Update;
     1663begin
     1664  Form1.Label2.Caption := 'Offline';
     1665  Form1.Label2.Font.Color := clRed;
     1666end;
     1667
    16411668end.
Note: See TracChangeset for help on using the changeset viewer.