IdHTTP1 i Image.Canvas :: 4programmers.net

0

Napisałem program, który fajnie pokazuje graficznie transfer na Image, rysowanie umieściłem w wątku.

I mam pewien problem, gdy przytrzymam za uchwyt Form to robi Pause przy ściąganiu a wykres dalej sie rysuje i wtedy jest nie zgodny z prawdą.

Jak zrobić aby umieścić IdHTTP1.get w watku jeżeli mam pętle. Coś czytałem na temat wielowątkowości, ale nigdzie konkretnego przykładu nie znalazłem, który by rozwiązał mój problem.

A może jest innny sposób na to?

Czekam na propozycje...

Za wszelkie pomoce bardzo dziękuje.

0

wstawić komponent w wątek :>

0

Wstawiłem komponent w watek, żadnego błędu nie wyświetla, ale gdy się odwołuje do

aa:=Watek.IdHTTP1.Get('http://...............');

Pojawia mi się taki komunikat:

http://f7.pl/dt/watek.jpg

Pozdrawiam...

0

więcej kodu

0

Mówisz i masz:

unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Forms,Controls, IdRawBase, IdRawClient, IdIcmpClient,
  ExtCtrls, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  IdHTTP, StdCtrls, ComCtrls, Menus,Dialogs;
type
  TForm1 = class(TForm)
    IdHTTP1: TIdHTTP;
    Button1: TButton;
    Edit2: TEdit;
    Edit3: TEdit;
    IdIcmpClient1: TIdIcmpClient;
    ListBox1: TListBox;
    Timer2: TTimer;
    GroupBox1: TGroupBox;
    Label6: TLabel;
    Label7: TLabel;
    GroupBox3: TGroupBox;
    GroupBox2: TGroupBox;
    GroupBox4: TGroupBox;
    Bevel1: TBevel;
    Label4: TLabel;
    Label5: TLabel;
    Image1: TImage;
    procedure Button1Click(Sender: TObject);
    procedure IdHTTP1Status(ASender: TObject; const AStatus: TIdStatus;
      const AStatusText: String);
    procedure IdHTTP1Work(Sender: TObject; AWorkMode: TWorkMode;
      const AWorkCount: Integer);
    procedure IdHTTP1WorkBegin(Sender: TObject; AWorkMode: TWorkMode;
      const AWorkCountMax: Integer);
    procedure IdIcmpClient1Reply(ASender: TComponent;
      const AReplyStatus: TReplyStatus);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormDestroy(Sender: TObject);
    procedure IdHTTP1Disconnected(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
    procedure StopPing1Click(Sender: TObject);
    procedure IdHTTP1Connected(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
  TWatek = class(TThread)
  protected
    procedure Execute; override;
     public
     Form:TForm;
  end;
var
  Watek : TWatek;
  Form1: TForm1;
  b:integer;
  a,c,size:extended;
  aa:string;
  Year, Month, Day,Hour, Min, Sec, Sec1, Milli : Word;
implementation
{$R *.dfm}
procedure TWatek.Execute;
var
  Image1:timage;
  Edit2:Tedit;
  IdHTTP1:TIdHTTP;
  aa:string;
begin
  Image1:=Form.FindComponent('Image1') as TImage;
  Edit2:=Form.FindComponent('Edit2') as TEdit;
  IdHTTP1:=Form.FindComponent('IdHTTP1') as TIdHTTP;
  FreeOnTerminate := true;
  while not (Application.Terminated) or (Terminated) do
  begin
    Application.ProcessMessages;
    Image1.Canvas.Pen.Color:=clred;
    Image1.Canvas.Pen.Width:=1;
    Image1.Canvas.MoveTo(125,94);
    Image1.Canvas.LineTo(125,94-(round(strtoFloat(edit2.Text)) div 4));
    Image1.Canvas.CopyRect( Rect(0, 0, 126, 96), Image1.Canvas, Rect(1, 0, 127,96));
    a:=a+0.1;
    Sleep(100);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if Button1.Caption='Check Speed' then begin
  Application.ProcessMessages;
  Edit3.Text:='0';
  aa:=IdHTTP1.Get('http://icm.tucows.com/files2/obm-win.exe');
  end
  else
  begin
    IdHTTP1.Disconnect;
    Button1.Enabled:=true;
    b:=0;
  end;
end;

procedure TForm1.IdHTTP1Status(ASender: TObject; const AStatus: TIdStatus;
  const AStatusText: String);
begin
  ListBox1.Items.Add(AStatustext);
  Listbox1.ItemIndex:=Listbox1.Items.Count-1;
  Application.ProcessMessages;
end;

procedure TForm1.IdHTTP1Work(Sender: TObject; AWorkMode: TWorkMode;
  const AWorkCount: Integer);
begin
  if watek.Suspended then
    begin
      a:=0.01;
      Watek.Form:=Form1;
      Watek.Resume;
    end;
    size:= AWorkCount / 1024;
    Application.ProcessMessages;
    edit2.Text:=FloatToStrf(size / a,fffixed,6,2);
    Application.ProcessMessages;
    if strtoFloat(Edit3.Text) < strtoFloat(Edit2.Text) then edit3.Text:=edit2.Text;
    Application.ProcessMessages;
end;

procedure TForm1.IdHTTP1WorkBegin(Sender: TObject; AWorkMode: TWorkMode;
  const AWorkCountMax: Integer);
begin
  Button1.Caption:='Cancel';
  Application.ProcessMessages;
end;

procedure TForm1.IdIcmpClient1Reply(ASender: TComponent;
  const AReplyStatus: TReplyStatus);
var
  sTime: string;
begin

  Application.ProcessMessages;
  if (IdIcmpClient1.ReplyStatus.MsRoundTripTime = 0) then
    sTime := '<1'
  else
    sTime := '=';
    if IdIcmpClient1.ReplyStatus.BytesReceived<>0 then begin
    Application.ProcessMessages;
    ListBox1.Items.Add(Format('Odpowiedź z %s: bajtów=%d czas%s%dms TTL=%d',
    [IdIcmpClient1.ReplyStatus.FromIpAddress,
    IdIcmpClient1.ReplyStatus.BytesReceived,
    sTime,
    IdIcmpClient1.ReplyStatus.MsRoundTripTime,
    IdIcmpClient1.ReplyStatus.TimeToLive]));
  end
  else ListBox1.Items.Add('Upłynął limit czasu żądania.');
  Timer2.Enabled:=true;
  Application.ProcessMessages;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  b:=1;
  IdHTTP1.Disconnect;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  b:=1;
  IdHTTP1.Disconnect;
end;

procedure TForm1.IdHTTP1Disconnected(Sender: TObject);
begin
  Button1.Caption:='Check Speed';
  Button1.Visible:=true;

  edit2.Text:='0';
  a:=0.0001;
  b:=0;
end;

procedure TForm1.Button6Click(Sender: TObject);
begin
  Canvas.Pen.Color:=clred;
  Canvas.Pen.Width:=1;
  Canvas.MoveTo(460,110);
  Canvas.LineTo(460,110-round(IdIcmpClient1.ReplyStatus.MsRoundTripTime));
  Application.ProcessMessages;
end;

procedure TForm1.Timer2Timer(Sender: TObject);
begin
  Timer2.Enabled:=false;
  IdIcmpClient1.ping;
  Listbox1.ItemIndex:=Listbox1.Items.Count-1;
  Application.ProcessMessages;
end;

procedure TForm1.Exit1Click(Sender: TObject);
begin
  Application.Terminate;
end;

procedure TForm1.StopPing1Click(Sender: TObject);
begin
  if Timer2.Enabled=true then
  begin
    Button1.Enabled:=true;
    Timer2.Enabled:=false;
    ListBox1.Items.Add('Przerwane przez użytkownika...');
    Listbox1.ItemIndex:=Listbox1.Items.Count-1;
  end
  else
  begin
    Timer2.Enabled:=true;
    Button1.Enabled:=false;
  end;
end;

procedure TForm1.IdHTTP1Connected(Sender: TObject);
begin
  b:=1;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Image1.Canvas.Create;
end;

initialization
  Watek := TWatek.Create(True);
end.

0

P.s to jest kod przed włożeniem komponentu w watek. Jak możesz to pokaż przykład jak to powinno zostać zrobione prawidłowo.

Wielkie dzięki.

0

  TWatek = class(TThread)
  protected
    procedure Execute; override;
     public
     <b>Form:TForm;</b>
  end;

gratuluję pomysłowości
czy ja piszę niewyraźnie albo po chińsku, czy napisałem FORMĘ czy komponent?????

0

Wiem, że czasem sie palnie jakieś głupoty...ale to były pozostałości po hardkorowych próbach.

kolejny popis do śmiania się:

Jest to z mojego rozumienia komponent IdHTTP1 w wątku, czy dobrze...sam oceń.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Forms,Controls, IdRawBase, IdRawClient, IdIcmpClient,
  ExtCtrls, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  IdHTTP, StdCtrls, ComCtrls, Menus,Dialogs;

type
  TForm1 = class(TForm)

    Button1: TButton;
    Edit2: TEdit;
    Edit3: TEdit;
    IdIcmpClient1: TIdIcmpClient;
    ListBox1: TListBox;
    Button4: TButton;
    Timer2: TTimer;
    GroupBox1: TGroupBox;
    Label6: TLabel;
    Label7: TLabel;
    GroupBox3: TGroupBox;
    GroupBox2: TGroupBox;
    GroupBox4: TGroupBox;
    Bevel1: TBevel;
    Label4: TLabel;
    Label5: TLabel;
    Image1: TImage;
    procedure Button1Click(Sender: TObject);

    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormDestroy(Sender: TObject);

    procedure Button6Click(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
    procedure StopPing1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
  TWatek = class(TThread)
  IdHTTP1: TIdHTTP;
  procedure IdHTTP1Status(ASender: TObject; const AStatus: TIdStatus;
      const AStatusText: String);
    procedure IdHTTP1Work(Sender: TObject; AWorkMode: TWorkMode;
      const AWorkCount: Integer);
    procedure IdHTTP1WorkBegin(Sender: TObject; AWorkMode: TWorkMode;
      const AWorkCountMax: Integer);
    procedure IdIcmpClient1Reply(ASender: TComponent;
      const AReplyStatus: TReplyStatus);
    procedure IdHTTP1Disconnected(Sender: TObject);
    procedure IdHTTP1Connected(Sender: TObject);
  protected
    procedure Execute; override;
     public
  end;
var
  Watek : TWatek;
  Form1: TForm1;
  b:integer;
  a,c,size:extended;
  aa:string;
  Year, Month, Day,Hour, Min, Sec, Sec1, Milli : Word;
implementation

{$R *.dfm}
procedure TWatek.Execute;
var
  Image1:timage;
  Edit2:Tedit;
  IdHTTP1:TIdHTTP;
  aa:string;
begin
  Image1:=Form1.FindComponent('Image1') as TImage;
  Edit2:=Form1.FindComponent('Edit2') as TEdit;
  IdHTTP1:=Form1.FindComponent('IdHTTP1') as TIdHTTP;
  FreeOnTerminate := true;
  while not (Application.Terminated) or (Terminated) do
  begin
    Application.ProcessMessages;
    Image1.Canvas.Pen.Color:=clred;
    Image1.Canvas.Pen.Width:=1;
    Image1.Canvas.MoveTo(125,94);
    Image1.Canvas.LineTo(125,94-(round(strtoFloat(edit2.Text)) div 4));
    Image1.Canvas.CopyRect( Rect(0, 0, 126, 96), Image1.Canvas, Rect(1, 0, 127,96));
    a:=a+0.1;
    Sleep(100);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if Button1.Caption='Check Speed' then begin
  Application.ProcessMessages;
  Edit3.Text:='0';
  aa:=watek.IdHTTP1.Get('http://icm.tucows.com/files2/obm-win.exe');
  end
  else
  begin
    watek.IdHTTP1.Disconnect;
    Button1.Enabled:=true;
    b:=0;
  end;
end;

procedure Twatek.IdHTTP1Status(ASender: TObject; const AStatus: TIdStatus;
  const AStatusText: String);
begin
  form1.ListBox1.Items.Add(AStatustext);
  form1.Listbox1.ItemIndex:=form1.Listbox1.Items.Count-1;
  Application.ProcessMessages;
end;

procedure Twatek.IdHTTP1Work(Sender: TObject; AWorkMode: TWorkMode;
  const AWorkCount: Integer);
begin
  if watek.Suspended then
    begin
      a:=0.01;
      Watek.Resume;
    end;
    size:= AWorkCount / 1024;
    Application.ProcessMessages;
    form1.edit2.Text:=FloatToStrf(size / a,fffixed,6,2);
    Application.ProcessMessages;
    if strtoFloat(form1.Edit3.Text) < strtoFloat(form1.Edit2.Text) then form1.edit3.Text:=form1.edit2.Text;
    Application.ProcessMessages;
end;

procedure Twatek.IdHTTP1WorkBegin(Sender: TObject; AWorkMode: TWorkMode;
  const AWorkCountMax: Integer);
begin
  form1.Button1.Caption:='Cancel';
  Application.ProcessMessages;
end;

procedure Twatek.IdIcmpClient1Reply(ASender: TComponent;
  const AReplyStatus: TReplyStatus);
var
  sTime: string;
begin

  Application.ProcessMessages;
  if (form1.IdIcmpClient1.ReplyStatus.MsRoundTripTime = 0) then
    sTime := '<1'
  else
    sTime := '=';
    if form1.IdIcmpClient1.ReplyStatus.BytesReceived<>0 then begin
    Application.ProcessMessages;
    form1.ListBox1.Items.Add(Format('Odpowiedź z %s: bajtów=%d czas%s%dms TTL=%d',
    [form1.IdIcmpClient1.ReplyStatus.FromIpAddress,
    form1.IdIcmpClient1.ReplyStatus.BytesReceived,
    sTime,
    form1.IdIcmpClient1.ReplyStatus.MsRoundTripTime,
    form1.IdIcmpClient1.ReplyStatus.TimeToLive]));
  end
  else form1.ListBox1.Items.Add('Upłynął limit czasu żądania.');
  form1.Timer2.Enabled:=true;
  Application.ProcessMessages;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  b:=1;
  watek.IdHTTP1.Disconnect;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  b:=1;
  watek.IdHTTP1.Disconnect;
end;

procedure Twatek.IdHTTP1Disconnected(Sender: TObject);
begin
  form1.Button1.Caption:='Check Speed';
  form1.Button1.Visible:=true;
  form1.Button4.Enabled:=true;
  form1.edit2.Text:='0';
  a:=0.0001;
  b:=0;
end;

procedure TForm1.Button6Click(Sender: TObject);
begin
  Canvas.Pen.Color:=clred;
  Canvas.Pen.Width:=1;
  Canvas.MoveTo(460,110);
  Canvas.LineTo(460,110-round(IdIcmpClient1.ReplyStatus.MsRoundTripTime));
  Application.ProcessMessages;
end;

procedure TForm1.Timer2Timer(Sender: TObject);
begin
  Timer2.Enabled:=false;
  IdIcmpClient1.ping;
  Listbox1.ItemIndex:=Listbox1.Items.Count-1;
  Application.ProcessMessages;
end;

procedure TForm1.Exit1Click(Sender: TObject);
begin
  Application.Terminate;
end;

procedure TForm1.StopPing1Click(Sender: TObject);
begin
  if Timer2.Enabled=true then
  begin
    Button1.Enabled:=true;
    Timer2.Enabled:=false;
    ListBox1.Items.Add('Przerwane przez użytkownika...');
    Listbox1.ItemIndex:=Listbox1.Items.Count-1;
  end
  else
  begin
    Timer2.Enabled:=true;
    Button1.Enabled:=false;
  end;
end;

procedure Twatek.IdHTTP1Connected(Sender: TObject);
begin
  b:=1;
  form1.Button4.Enabled:=false;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Image1.Canvas.Create;
end;

initialization
  Watek := TWatek.Create(True);
end.

0

ja wymiękam. Aż dziw bierze, że to działa. Masz chłopie szczęście.
Z mojej strony rada jest taka - poczytaj o wątkach, co to w ogóle jest, do czego służy. Poczytaj o przepływie komunikatów w aplikacji, o synchronizacji, o sekcjach krytycznych, o mutexach. Potem poczytaj o dynamicznym tworzeniu komponentów i wtedy wróć i zapytaj jeszcze raz jak dalej będziesz miał jakiś problem

IdHTTP1 i Image.Canvas

1 użytkowników online, w tym zalogowanych: 0, gości: 1

Praca dla programistów

Forum dyskusyjne

Sprawy administracyjne

O nas

Skontaktuj się z nami