| 1 | unit News;
|
|---|
| 2 |
|
|---|
| 3 | interface
|
|---|
| 4 |
|
|---|
| 5 | uses
|
|---|
| 6 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
|
|---|
| 7 | Dialogs,
|
|---|
| 8 | // kvůli třídě aby byla jenom 1x
|
|---|
| 9 | Main, StdCtrls, ComCtrls, ExtCtrls, xmldom, XMLIntf, msxmldom, XMLDoc, Registry,
|
|---|
| 10 | ImgList, CoolTrayIcon, OleCtrls, SHDocVw, ActiveX, shellapi;
|
|---|
| 11 |
|
|---|
| 12 | type
|
|---|
| 13 | TForm6 = class(TForm)
|
|---|
| 14 | ListView1: TListView;
|
|---|
| 15 | Panel1: TPanel;
|
|---|
| 16 | XMLDocument1: TXMLDocument;
|
|---|
| 17 | ImageList1: TImageList;
|
|---|
| 18 | Panel2: TPanel;
|
|---|
| 19 | WebBrowser1: TWebBrowser;
|
|---|
| 20 | procedure Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
|
|---|
| 21 | Y: Integer);
|
|---|
| 22 | procedure Panel1MouseDown(Sender: TObject; Button: TMouseButton;
|
|---|
| 23 | Shift: TShiftState; X, Y: Integer);
|
|---|
| 24 | procedure Panel1MouseUp(Sender: TObject; Button: TMouseButton;
|
|---|
| 25 | Shift: TShiftState; X, Y: Integer);
|
|---|
| 26 | procedure ListView1SelectItem(Sender: TObject; Item: TListItem;
|
|---|
| 27 | Selected: Boolean);
|
|---|
| 28 | procedure FormCreate(Sender: TObject);
|
|---|
| 29 | procedure FormClose(Sender: TObject; var Action: TCloseAction);
|
|---|
| 30 | procedure FormResize(Sender: TObject);
|
|---|
| 31 | procedure WebBrowser1BeforeNavigate2(Sender: TObject;
|
|---|
| 32 | const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
|
|---|
| 33 | Headers: OleVariant; var Cancel: WordBool);
|
|---|
| 34 | procedure FormShow(Sender: TObject);
|
|---|
| 35 | private
|
|---|
| 36 | { Private declarations }
|
|---|
| 37 | procedure WMMoving(var Message: TWMMoving); message WM_MOVING;
|
|---|
| 38 | procedure MoveNews(StartMove: integer);
|
|---|
| 39 | function WithOutTags(StringHtml: string): string;
|
|---|
| 40 | function GetHtmlCodeWithTags(sString: string): string;
|
|---|
| 41 | procedure WBLoadHTML(WebBrowser: TWebBrowser; HTMLCode: string) ;
|
|---|
| 42 | public
|
|---|
| 43 | { Public declarations }
|
|---|
| 44 |
|
|---|
| 45 | // veřejné proměné
|
|---|
| 46 | News: array of record
|
|---|
| 47 | Name: string;
|
|---|
| 48 | Text: string;
|
|---|
| 49 | Read: integer;
|
|---|
| 50 | pubDate: string;
|
|---|
| 51 | end;
|
|---|
| 52 |
|
|---|
| 53 | procedure DrawForm;
|
|---|
| 54 |
|
|---|
| 55 | procedure SaveRegRSS;
|
|---|
| 56 | procedure SaveRegNewsOptions;
|
|---|
| 57 | procedure LoadRegRSS;
|
|---|
| 58 | procedure LoadRegNewsOptions;
|
|---|
| 59 | procedure DownloadRSS;
|
|---|
| 60 | procedure WriteNews;
|
|---|
| 61 |
|
|---|
| 62 | end;
|
|---|
| 63 |
|
|---|
| 64 | var
|
|---|
| 65 | Form6: TForm6;
|
|---|
| 66 | //nastavení
|
|---|
| 67 | PlaySoundNews: Boolean;
|
|---|
| 68 | SoundFileNews: String;
|
|---|
| 69 |
|
|---|
| 70 | implementation
|
|---|
| 71 |
|
|---|
| 72 | uses Types, Math;
|
|---|
| 73 |
|
|---|
| 74 | {$R *.dfm}
|
|---|
| 75 |
|
|---|
| 76 | { TForm6 }
|
|---|
| 77 |
|
|---|
| 78 | procedure TForm6.WMMoving(var Message: TWMMoving);
|
|---|
| 79 | var
|
|---|
| 80 | OriginalWidth, OriginalHeight: integer;
|
|---|
| 81 | const
|
|---|
| 82 | SnapPixels = 4;
|
|---|
| 83 | begin
|
|---|
| 84 | DockingNews := False;
|
|---|
| 85 | OriginalWidth := Width;
|
|---|
| 86 | OriginalHeight := Height;
|
|---|
| 87 | if (WindowState = wsNormal) and Visible then
|
|---|
| 88 | begin
|
|---|
| 89 | if (Message.Coord.Left < (Form1.Left+Form1.Width + SnapPixels)) and (Message.Coord.Left > (Form1.Left+Form1.Width - SnapPixels)) and
|
|---|
| 90 | (Form1.Top <= Message.Coord.Top) and (Form1.Top+Form1.Height >= Message.Coord.Top) then begin
|
|---|
| 91 | Message.Coord.Left := Form1.Left+Form1.Width; //pravá strana hlavního
|
|---|
| 92 | DockingNews := True;
|
|---|
| 93 | end;
|
|---|
| 94 |
|
|---|
| 95 | if (Message.Coord.Top < (Form1.Top+Form1.Height + SnapPixels)) and (Message.Coord.Top > (Form1.Top+Form1.Height - SnapPixels)) and
|
|---|
| 96 | (Form1.Left <= Message.Coord.Right) and (Form1.Left+Form1.Width >= Message.Coord.Left) then begin
|
|---|
| 97 | Message.Coord.Top := Form1.Top+Form1.Height; //spodní strana hlavního
|
|---|
| 98 | DockingNews := True;
|
|---|
| 99 | end;
|
|---|
| 100 |
|
|---|
| 101 | if (Message.Coord.Bottom > (Form1.Top - SnapPixels)) and (Message.Coord.Bottom < (Form1.Top + SnapPixels)) and
|
|---|
| 102 | (Form1.Left <= Message.Coord.Right) and (Form1.Left+Form1.Width >= Message.Coord.Left) then begin
|
|---|
| 103 | Message.Coord.Top := Form1.Top - Height; //horní strana hlavního
|
|---|
| 104 | DockingNews := True;
|
|---|
| 105 | end;
|
|---|
| 106 |
|
|---|
| 107 | if (Message.Coord.Right > (Form1.Left - SnapPixels)) and (Message.Coord.Right < (Form1.Left + SnapPixels)) and
|
|---|
| 108 | (Form1.Top <= Message.Coord.Top) and (Form1.Top+Form1.Height >= Message.Coord.Top) then begin
|
|---|
| 109 | Message.Coord.Left := Form1.Left - Width; // levá strana dolního
|
|---|
| 110 | DockingNews := True;
|
|---|
| 111 | end;
|
|---|
| 112 |
|
|---|
| 113 | end;
|
|---|
| 114 | Message.Coord.Right := Message.Coord.Left + OriginalWidth;
|
|---|
| 115 | Message.Coord.Bottom := Message.Coord.Top + OriginalHeight;
|
|---|
| 116 | end;
|
|---|
| 117 |
|
|---|
| 118 | procedure TForm6.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
|
|---|
| 119 | Y: Integer);
|
|---|
| 120 | var
|
|---|
| 121 | Position: TPoint;
|
|---|
| 122 | begin
|
|---|
| 123 | if DragDown then begin
|
|---|
| 124 | GetCursorPos(Position);
|
|---|
| 125 | Panel1.Top := Position.Y-Top-Panel1.Height-16;
|
|---|
| 126 | DrawForm;
|
|---|
| 127 | end;
|
|---|
| 128 | end;
|
|---|
| 129 |
|
|---|
| 130 | procedure TForm6.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
|
|---|
| 131 | Shift: TShiftState; X, Y: Integer);
|
|---|
| 132 | begin
|
|---|
| 133 | DragDown := true;
|
|---|
| 134 | GetCursorPos(StartPosition);
|
|---|
| 135 | end;
|
|---|
| 136 |
|
|---|
| 137 | procedure TForm6.Panel1MouseUp(Sender: TObject; Button: TMouseButton;
|
|---|
| 138 | Shift: TShiftState; X, Y: Integer);
|
|---|
| 139 | begin
|
|---|
| 140 | DragDown := false;
|
|---|
| 141 | end;
|
|---|
| 142 |
|
|---|
| 143 | procedure TForm6.DrawForm;
|
|---|
| 144 | begin
|
|---|
| 145 | ListView1.Height := Panel1.Top;
|
|---|
| 146 | Panel2.Top := Panel1.Top+Panel1.Height;
|
|---|
| 147 | Panel2.Height := Height-Panel1.Top-Panel1.Height-20;
|
|---|
| 148 | end;
|
|---|
| 149 |
|
|---|
| 150 | procedure TForm6.ListView1SelectItem(Sender: TObject; Item: TListItem;
|
|---|
| 151 | Selected: Boolean);
|
|---|
| 152 | begin
|
|---|
| 153 | if Assigned(ListView1.Selected) then begin
|
|---|
| 154 | // Memo1.Text := ListView1.Selected.SubItems.Text;
|
|---|
| 155 | WBLoadHTML(WebBrowser1,GetHtmlCodeWithTags('<span style="font-size: 12px;">'+ListView1.Selected.SubItems.Text+'</span>'));
|
|---|
| 156 | ListView1.Selected.ImageIndex := 1;
|
|---|
| 157 | News[ListView1.Selected.Index].Read := 1;
|
|---|
| 158 | // ListView1.Selected.Caption := IntToStr( ListView1.Selected.Index);
|
|---|
| 159 | end;
|
|---|
| 160 | end;
|
|---|
| 161 |
|
|---|
| 162 | procedure TForm6.DownloadRSS;
|
|---|
| 163 | var
|
|---|
| 164 | ANode : IXMLNode;
|
|---|
| 165 | STitle, sDesc : WideString; //, sLink
|
|---|
| 166 | i: integer;
|
|---|
| 167 | NewNews: array of record
|
|---|
| 168 | Name: string;
|
|---|
| 169 | Text: string;
|
|---|
| 170 | Read: integer;
|
|---|
| 171 | pubDate: string;
|
|---|
| 172 | end;
|
|---|
| 173 | pubDate: string;
|
|---|
| 174 | HaveNewNews: Boolean;
|
|---|
| 175 | begin
|
|---|
| 176 | //points to local XML file in "original" code
|
|---|
| 177 | try
|
|---|
| 178 | XMLDocument1.FileName := RSSAddress;
|
|---|
| 179 | XMLDocument1.Active:=True;
|
|---|
| 180 |
|
|---|
| 181 | ANode := XMLDocument1.DocumentElement.ChildNodes.First.ChildNodes.FindNode('item');
|
|---|
| 182 | repeat
|
|---|
| 183 | STitle := ANode.ChildNodes['title'].Text;
|
|---|
| 184 | // sLink := ANode.ChildNodes['link'].Text;
|
|---|
| 185 | sDesc := ANode.ChildNodes['description'].Text;
|
|---|
| 186 | pubDate := ANode.ChildNodes['pubDate'].Text;
|
|---|
| 187 |
|
|---|
| 188 | SetLength(NewNews,length(NewNews)+1);
|
|---|
| 189 | NewNews[length(NewNews)-1].Name := STitle;
|
|---|
| 190 | NewNews[length(NewNews)-1].Text := WithOutTags(sDesc);
|
|---|
| 191 | NewNews[length(NewNews)-1].pubDate := pubDate;
|
|---|
| 192 | NewNews[length(NewNews)-1].Read := 0;
|
|---|
| 193 |
|
|---|
| 194 | ANode := ANode.NextSibling;
|
|---|
| 195 | until ANode = nil;
|
|---|
| 196 |
|
|---|
| 197 | HaveNewNews := False;
|
|---|
| 198 | if Length(News) = 0 then begin
|
|---|
| 199 | SetLength(News,length(NewNews));
|
|---|
| 200 | for i:=0 to length(NewNews)-1 do begin
|
|---|
| 201 | News[i].Name := NewNews[i].Name;
|
|---|
| 202 | News[i].Text := NewNews[i].Text;
|
|---|
| 203 | News[i].Read := NewNews[i].Read;
|
|---|
| 204 | News[i].pubDate := NewNews[i].pubDate;
|
|---|
| 205 | end;
|
|---|
| 206 | end else begin
|
|---|
| 207 | for i := 0 to length(NewNews) - 1 do begin
|
|---|
| 208 | if News[i].pubDate = NewNews[i].pubDate then begin
|
|---|
| 209 |
|
|---|
| 210 | end else begin
|
|---|
| 211 | HaveNewNews := True;
|
|---|
| 212 | MoveNews(i);
|
|---|
| 213 | News[i].Name := NewNews[i].Name;
|
|---|
| 214 | News[i].Text := NewNews[i].Text;
|
|---|
| 215 | News[i].Read := NewNews[i].Read;
|
|---|
| 216 | News[i].pubDate := NewNews[i].pubDate;
|
|---|
| 217 | end;
|
|---|
| 218 | end;
|
|---|
| 219 | end;
|
|---|
| 220 |
|
|---|
| 221 | if HaveNewNews then begin
|
|---|
| 222 | if SoundAfterNewNews then
|
|---|
| 223 | Beep;
|
|---|
| 224 | if PlaySoundNews then
|
|---|
| 225 | Form1.MediaPlay(SoundFileNews);
|
|---|
| 226 | if ShowBalloonHint then
|
|---|
| 227 | Form1.CoolTrayIcon1.ShowBalloonHint(Form1.Caption+' - Nová Aktualita',News[0].Name,bitInfo,10);
|
|---|
| 228 | Form1.StatusBar1.SimpleText := 'Nová aktualita';
|
|---|
| 229 | end else begin
|
|---|
| 230 | Form1.StatusBar1.SimpleText := 'Žádné nové aktuality';
|
|---|
| 231 | end;
|
|---|
| 232 | except
|
|---|
| 233 | On E : Exception do
|
|---|
| 234 | Form1.StatusBar1.SimpleText := 'Nepodařilo se zjistit nové aktuality';
|
|---|
| 235 | end;
|
|---|
| 236 | end;
|
|---|
| 237 |
|
|---|
| 238 | procedure TForm6.LoadRegRSS;
|
|---|
| 239 | var
|
|---|
| 240 | reg: TRegistry;
|
|---|
| 241 | i, NewsCount: integer;
|
|---|
| 242 | begin
|
|---|
| 243 | Reg := TRegistry.Create;
|
|---|
| 244 | try
|
|---|
| 245 | if Reg.OpenKey(R+'News', False) then begin
|
|---|
| 246 | if reg.ValueExists('count') then begin
|
|---|
| 247 | NewsCount := Reg.ReadInteger('Count');
|
|---|
| 248 | SetLength(News,NewsCount);
|
|---|
| 249 | for i := 0 to NewsCount-1 do
|
|---|
| 250 | if Reg.OpenKey(R+'News'+IntToStr(i), False) then begin
|
|---|
| 251 | News[i].Name := Reg.ReadString('name');
|
|---|
| 252 | News[i].Text := Reg.ReadString('Text');
|
|---|
| 253 | News[i].Read := Reg.ReadInteger('Read');
|
|---|
| 254 | News[i].pubDate := Reg.Readstring('pubDate');
|
|---|
| 255 | // SubItems.Add(sLink);
|
|---|
| 256 | end;
|
|---|
| 257 | end;
|
|---|
| 258 | end;
|
|---|
| 259 | finally
|
|---|
| 260 | Reg.Free;
|
|---|
| 261 | end;
|
|---|
| 262 | end;
|
|---|
| 263 |
|
|---|
| 264 | procedure TForm6.SaveRegRSS;
|
|---|
| 265 | var
|
|---|
| 266 | reg: TRegistry;
|
|---|
| 267 | i: Integer;
|
|---|
| 268 | begin
|
|---|
| 269 | Reg := TRegistry.Create;
|
|---|
| 270 | try
|
|---|
| 271 | Reg.RootKey := HKEY_CURRENT_USER;
|
|---|
| 272 |
|
|---|
| 273 | // Uložení seznamu serverů
|
|---|
| 274 | for i := 0 to ListView1.Items.Count-1 do
|
|---|
| 275 | if Reg.OpenKey(R+'News'+IntToStr(i), True) then
|
|---|
| 276 | with News[I] do begin
|
|---|
| 277 | Reg.WriteString('name', Name);
|
|---|
| 278 | Reg.WriteString('Text',Text);
|
|---|
| 279 | reg.WriteInteger('Read',Read);
|
|---|
| 280 | reg.WriteString('pubDate',pubDate);
|
|---|
| 281 | end;
|
|---|
| 282 | if Reg.OpenKey(R+'News', True) then
|
|---|
| 283 | Reg.WriteInteger('count',length(News));
|
|---|
| 284 |
|
|---|
| 285 | finally
|
|---|
| 286 | Reg.Free;
|
|---|
| 287 | end;
|
|---|
| 288 | end;
|
|---|
| 289 |
|
|---|
| 290 | procedure TForm6.LoadRegNewsOptions;
|
|---|
| 291 | var
|
|---|
| 292 | reg: TRegistry;
|
|---|
| 293 | i: integer;
|
|---|
| 294 | begin
|
|---|
| 295 | Reg := TRegistry.Create;
|
|---|
| 296 | try
|
|---|
| 297 | // načítání pozice formuláře
|
|---|
| 298 | if Reg.OpenKey(R+'NewsForm', False) then begin
|
|---|
| 299 | Top := Reg.ReadInteger('Top');
|
|---|
| 300 | Left := Reg.ReadInteger('Left');
|
|---|
| 301 | Height := Reg.ReadInteger('Height');
|
|---|
| 302 | Width := Reg.ReadInteger('Width');
|
|---|
| 303 | if Reg.ReadBool('Maximized') then
|
|---|
| 304 | WindowState := wsMaximized
|
|---|
| 305 | else
|
|---|
| 306 | WindowState := wsNormal;
|
|---|
| 307 | end;
|
|---|
| 308 |
|
|---|
| 309 | //načítání velikosti panelů a zobrazení
|
|---|
| 310 | if Reg.OpenKey(R+'Newsdisplay', False) then begin
|
|---|
| 311 | i := Reg.ReadInteger('ViewStyle');
|
|---|
| 312 | case i of
|
|---|
| 313 | 1: ListView1.ViewStyle := vsIcon;
|
|---|
| 314 | 2: ListView1.ViewStyle := vsList;
|
|---|
| 315 | 3: ListView1.ViewStyle := vsReport;
|
|---|
| 316 | 4: ListView1.ViewStyle := vsSmallIcon;
|
|---|
| 317 | end;
|
|---|
| 318 | ListView1.Columns[0].Width := Reg.ReadInteger('Columns0Width');
|
|---|
| 319 | Form6.Panel1.Top := Reg.ReadInteger('PanelLeft');
|
|---|
| 320 | end;
|
|---|
| 321 |
|
|---|
| 322 | if Reg.OpenKey(R+'NewsOptions', False) then begin
|
|---|
| 323 | if reg.ValueExists('SoundFileNews') then SoundFileNews := Reg.ReadString('SoundFileNews');
|
|---|
| 324 | if reg.ValueExists('PlaySoundNews') then PlaySoundNews := Reg.ReadBool('PlaySoundNews');
|
|---|
| 325 | end;
|
|---|
| 326 |
|
|---|
| 327 | finally
|
|---|
| 328 | Reg.Free;
|
|---|
| 329 | end;
|
|---|
| 330 | end;
|
|---|
| 331 |
|
|---|
| 332 | procedure TForm6.SaveRegNewsOptions;
|
|---|
| 333 | var
|
|---|
| 334 | reg: TRegistry;
|
|---|
| 335 | i: integer;
|
|---|
| 336 | begin
|
|---|
| 337 | Reg := TRegistry.Create(KEY_WRITE);
|
|---|
| 338 | try
|
|---|
| 339 | Reg.RootKey := HKEY_CURRENT_USER;
|
|---|
| 340 | // uložení pozice formuláře
|
|---|
| 341 | if Reg.OpenKey(R+'NewsForm', True) then begin
|
|---|
| 342 | Reg.WriteInteger('Top', Top);
|
|---|
| 343 | Reg.WriteInteger('Left', Left);
|
|---|
| 344 | Reg.WriteInteger('Height', Height);
|
|---|
| 345 | Reg.WriteInteger('Width', Width);
|
|---|
| 346 | Reg.WriteBool('Maximized', WindowState = wsMaximized);
|
|---|
| 347 | end;
|
|---|
| 348 |
|
|---|
| 349 | //ukládání velikosti panelů a zobrazení
|
|---|
| 350 | i := 0;
|
|---|
| 351 | if Reg.OpenKey(R+'Newsdisplay', True) then begin
|
|---|
| 352 | if ListView1.ViewStyle = vsIcon then
|
|---|
| 353 | i := 1;
|
|---|
| 354 | if ListView1.ViewStyle = vsList then
|
|---|
| 355 | i := 2;
|
|---|
| 356 | if ListView1.ViewStyle = vsReport then
|
|---|
| 357 | i := 3;
|
|---|
| 358 | if ListView1.ViewStyle = vsSmallIcon then
|
|---|
| 359 | i := 4;
|
|---|
| 360 |
|
|---|
| 361 | Reg.WriteInteger('ViewStyle',i);
|
|---|
| 362 |
|
|---|
| 363 | Reg.WriteInteger('Columns0Width',ListView1.Columns[0].Width);
|
|---|
| 364 | Reg.WriteInteger('PanelLeft',Form6.Panel1.Top);
|
|---|
| 365 |
|
|---|
| 366 | end;
|
|---|
| 367 |
|
|---|
| 368 | if Reg.OpenKey(R+'NewsOptions', True) then begin
|
|---|
| 369 | Reg.WriteString('SoundFileNews',SoundFileNews);
|
|---|
| 370 | Reg.WriteBool('PlaySoundNews',PlaySoundNews);
|
|---|
| 371 | end;
|
|---|
| 372 |
|
|---|
| 373 | finally
|
|---|
| 374 | Reg.Free;
|
|---|
| 375 | end;
|
|---|
| 376 | end;
|
|---|
| 377 |
|
|---|
| 378 | procedure TForm6.FormCreate(Sender: TObject);
|
|---|
| 379 | begin
|
|---|
| 380 | LoadRegNewsOptions;
|
|---|
| 381 | end;
|
|---|
| 382 |
|
|---|
| 383 | procedure TForm6.WriteNews;
|
|---|
| 384 | var
|
|---|
| 385 | i: integer;
|
|---|
| 386 | begin
|
|---|
| 387 | ListView1.Clear;
|
|---|
| 388 | for i:=0 to Length(News)-1 do begin
|
|---|
| 389 | with ListView1.Items.Add do begin
|
|---|
| 390 | Caption := News[i].Name;
|
|---|
| 391 | SubItems.Add(News[i].Text);
|
|---|
| 392 | ImageIndex := News[i].Read;
|
|---|
| 393 | end;
|
|---|
| 394 | end;
|
|---|
| 395 | end;
|
|---|
| 396 |
|
|---|
| 397 | procedure TForm6.MoveNews(StartMove: integer);
|
|---|
| 398 | var
|
|---|
| 399 | i: integer;
|
|---|
| 400 | begin
|
|---|
| 401 | SetLength(News,length(News)+1);
|
|---|
| 402 | i := Length(News)-1;
|
|---|
| 403 | repeat
|
|---|
| 404 | i := i-1;
|
|---|
| 405 | News[i+1].Name := News[i].Name;
|
|---|
| 406 | News[i+1].Text := News[i].Text;
|
|---|
| 407 | News[i+1].Read := News[i].Read;
|
|---|
| 408 | News[i+1].pubDate := News[i].pubDate;
|
|---|
| 409 | until i = StartMove;
|
|---|
| 410 | end;
|
|---|
| 411 |
|
|---|
| 412 | procedure TForm6.FormClose(Sender: TObject; var Action: TCloseAction);
|
|---|
| 413 | begin
|
|---|
| 414 | Form1.Aktuality1.Checked := False;
|
|---|
| 415 | end;
|
|---|
| 416 |
|
|---|
| 417 | function TForm6.WithOutTags(StringHtml: string): string;
|
|---|
| 418 | begin
|
|---|
| 419 | StringHtml := StringReplace(StringHtml,chr(10),'',[rfReplaceAll]);
|
|---|
| 420 | StringHtml := StringReplace(StringHtml,chr(13),'',[rfReplaceAll]);
|
|---|
| 421 | StringHtml := StringReplace(StringHtml,'<br>',chr(13)+chr(10),[rfReplaceAll]);
|
|---|
| 422 | { repeat
|
|---|
| 423 | dataOut := dataOut+Copy(StringHtml,0,pos('<br>',StringHtml)-1)+chr(13);
|
|---|
| 424 | if dataOut <> '' then
|
|---|
| 425 | Delete(StringHtml,1,length(dataOut)+4);
|
|---|
| 426 | until (StringHtml = '') or (dataOut = '');
|
|---|
| 427 | if dataOut = '' then
|
|---|
| 428 | Result := StringHtml
|
|---|
| 429 | else
|
|---|
| 430 | Result := dataOut; }
|
|---|
| 431 | Result := StringHtml;
|
|---|
| 432 | end;
|
|---|
| 433 |
|
|---|
| 434 | procedure TForm6.FormResize(Sender: TObject);
|
|---|
| 435 | begin
|
|---|
| 436 | DrawForm;
|
|---|
| 437 | end;
|
|---|
| 438 |
|
|---|
| 439 | procedure TForm6.FormShow(Sender: TObject);
|
|---|
| 440 | begin
|
|---|
| 441 | DrawForm;
|
|---|
| 442 | LoadRegRSS;
|
|---|
| 443 | if Form1.Timer1.Enabled then begin
|
|---|
| 444 | DownloadRSS; //todo: vyjímka při nepřipojeném netu
|
|---|
| 445 | WriteNews;
|
|---|
| 446 | end;
|
|---|
| 447 | if Form1.Aktuality1.Checked and (StartMinimalize = false) then
|
|---|
| 448 | Form6.Show;
|
|---|
| 449 | end;
|
|---|
| 450 |
|
|---|
| 451 | procedure TForm6.WBLoadHTML(WebBrowser: TWebBrowser; HTMLCode: string);
|
|---|
| 452 | var
|
|---|
| 453 | sl: TStringList;
|
|---|
| 454 | ms: TMemoryStream;
|
|---|
| 455 | begin
|
|---|
| 456 | WebBrowser.Navigate('about:blank') ;
|
|---|
| 457 | while WebBrowser.ReadyState < READYSTATE_INTERACTIVE do
|
|---|
| 458 | Application.ProcessMessages;
|
|---|
| 459 |
|
|---|
| 460 | if Assigned(WebBrowser.Document) then
|
|---|
| 461 | begin
|
|---|
| 462 | sl := TStringList.Create;
|
|---|
| 463 | try
|
|---|
| 464 | ms := TMemoryStream.Create;
|
|---|
| 465 | try
|
|---|
| 466 | sl.Text := HTMLCode;
|
|---|
| 467 | sl.SaveToStream(ms) ;
|
|---|
| 468 | ms.Seek(0, 0) ;
|
|---|
| 469 | (WebBrowser.Document as IPersistStreamInit).Load(TStreamAdapter.Create(ms)) ;
|
|---|
| 470 | finally
|
|---|
| 471 | ms.Free;
|
|---|
| 472 | end;
|
|---|
| 473 | finally
|
|---|
| 474 | sl.Free;
|
|---|
| 475 | end;
|
|---|
| 476 | end;
|
|---|
| 477 | end;
|
|---|
| 478 |
|
|---|
| 479 | procedure TForm6.WebBrowser1BeforeNavigate2(Sender: TObject;
|
|---|
| 480 | const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
|
|---|
| 481 | Headers: OleVariant; var Cancel: WordBool);
|
|---|
| 482 | var
|
|---|
| 483 | newURL: string;
|
|---|
| 484 | begin
|
|---|
| 485 | newURL := URL;
|
|---|
| 486 | if (newURL <> 'about:blank') then
|
|---|
| 487 | begin
|
|---|
| 488 | Cancel := True;
|
|---|
| 489 | ShellExecute(Application.Handle, 'open', PChar(newURL), nil, nil, SW_NORMAL);
|
|---|
| 490 | end;
|
|---|
| 491 | end;
|
|---|
| 492 |
|
|---|
| 493 | function TForm6.GetHtmlCodeWithTags(sString: string): string;
|
|---|
| 494 | begin
|
|---|
| 495 | sString := StringReplace(sString,chr(13)+chr(10),'<br>',[rfReplaceAll]);
|
|---|
| 496 |
|
|---|
| 497 | Result := sString;
|
|---|
| 498 | end;
|
|---|
| 499 |
|
|---|
| 500 | end.
|
|---|
