Показать сообщение отдельно
  #13  
Старый 06.10.2015, 07:20
lmikle lmikle вне форума
Модератор
 
Регистрация: 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.
Ответить с цитированием