
06.10.2015, 07:20
|
Модератор
|
|
Регистрация: 17.04.2008
Сообщения: 8,107
Версия Delphi: 7, XE3, 10.2
Репутация: 49089
|
|
Ну не знаю, что у тебя там тормозит...
Сделал такую программку (на 9 камер правда, а не на 16). Спокойно все показывает, листает. Там только некоторых камер, походу, нет или они не работают (какое-то стандартное изображение с гербом выводится). Одна только проблема - TImage мыргает при перерисовке. Надо у формы DoubleBuffered выставлять.
Поток:
Код:
unit CamThrd;
interface
uses
SysUtils, Classes, Graphics, ExtCtrls, IdHTTP, Jpeg;
const
CamUrl = 'http://cam.pddd.perm.ru:81/?c=%d';
type
TCamThread = class(TThread)
private
{ Private declarations }
FCamNo : Integer;
FImage : TImage;
FHTTP : TIdHTTP;
FMemStream : TMemoryStream;
FJpeg : TJpegImage;
procedure UpdateImage;
protected
procedure Execute; override;
public
constructor Create(ACamNo : Integer; AImage : TImage); virtual;
destructor Destroy; override;
procedure SetCamNo(ACamNo : Integer);
end;
implementation
{ Important: Methods and properties of objects in visual components can only be
used in a method called using Synchronize, for example,
Synchronize(UpdateCaption);
and UpdateCaption could look like,
procedure TCamThread.UpdateCaption;
begin
Form1.Caption := 'Updated in a thread';
end; }
{ TCamThread }
constructor TCamThread.Create(ACamNo: Integer; AImage: TImage);
begin
FCamNo := ACamNo;
FImage := AImage;
FHTTP := TIdHTTP.Create(Nil);
FMemStream := TMemoryStream.Create;
FJpeg := TJpegImage.Create;
inherited Create(False);
end;
destructor TCamThread.Destroy;
begin
FHTTP.Free;
FMemStream.Free;
FJpeg.Free;
inherited;
end;
procedure TCamThread.Execute;
begin
While Not Terminated Do
Begin
FMemStream.Clear;
Try
FHTTP.Get(Format(CamUrl,[FCamNo]),FMemStream);
FMemStream.Seek(0,soFromBeginning);
If FMemStream.Size > 0
Then FJpeg.LoadFromStream(FMemStream);
Synchronize(UpdateImage);
Except
FJpeg.Width := 1;
FJpeg.Height := 1;
End;
If Not Terminated Then Sleep(2000);
End;
end;
procedure TCamThread.SetCamNo(ACamNo: Integer);
begin
FCamNo := ACamNo;
end;
procedure TCamThread.UpdateImage;
begin
If FImage <> Nil Then
FImage.Picture.Assign(FJpeg);
end;
end.
Главная формa:
Код:
unit MainFrm;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Jpeg, ExtCtrls, CamThrd, StdCtrls;
type
TMainForm = class(TForm)
Image1: TImage;
Image2: TImage;
Image3: TImage;
Image4: TImage;
Image5: TImage;
Image6: TImage;
Image7: TImage;
Image8: TImage;
Image9: TImage;
btPrev: TButton;
btNext: TButton;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
Label9: TLabel;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure btPrevClick(Sender: TObject);
procedure btNextClick(Sender: TObject);
private
{ Private declarations }
FThreads : Array [1..9] Of TCamThread;
FCamBias : Integer;
procedure UpdateCams;
public
{ Public declarations }
end;
var
MainForm: TMainForm;
implementation
{$R *.dfm}
procedure TMainForm.FormCreate(Sender: TObject);
var
I : Integer;
AImage : TImage;
ALabel : TLabel;
begin
Self.DoubleBuffered := True;
FCamBias := 0;
For I := 1 To 9 Do
Begin
AImage := Self.FindComponent('Image' + IntToStr(I)) As TImage;
FThreads[i] := TCamThread.Create(FCamBias*9 + I,AImage);
ALabel := Self.FindComponent('Label' + IntToStr(I)) As TLabel;
ALabel.Caption := IntToStr(FCamBias*9 + I);
End;
end;
procedure TMainForm.FormDestroy(Sender: TObject);
var
I : Integer;
begin
For I := 1 To 9 Do
Begin
FThreads[i].Terminate;
FThreads[i].WaitFor;
FThreads[i].Free;
End;
end;
procedure TMainForm.btPrevClick(Sender: TObject);
begin
If FCamBias <= 0
Then FCamBias := 0
Else FCamBias := FCamBias - 1;
UpdateCams;
end;
procedure TMainForm.UpdateCams;
var
I : Integer;
ALabel : TLabel;
begin
For I := 1 To 9 Do
Begin
FThreads[i].Suspend;
FThreads[i].SetCamNo(FCamBias*9 + I);
FThreads[i].Resume;
ALabel := Self.FindComponent('Label' + IntToStr(I)) As TLabel;
ALabel.Caption := IntToStr(FCamBias*9 + I);
End;
end;
procedure TMainForm.btNextClick(Sender: TObject);
begin
FCamBias := FCamBias + 1;
UpdateCams;
end;
end.
|