Через раз вылетает image - вопрос №51247

ПРи выполнении программы вылетает примерно через раз Image, то один то второй.Что не пробовал-не помогает. Думаю вся проблема в критических секциях, но все делал по книге, да и весь нет перерыл, ничего толкового не нашел, на вас последняя надежда))))

пример проги

 

unit Unit1;

 

interface

 

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, ExtCtrls, Menus, StdCtrls,math, Buttons, ComCtrls,SyncObjs;

 

type

  TForm1 = class(TForm)

    Image1: TImage;

    Image2: TImage;

    MainMenu1: TMainMenu; 

    Bevel1: TBevel;

    Bevel2: TBevel;

    Image3: TImage;

    Bevel3: TBevel;

    BitBtn1: TBitBtn;

    Edit7: TEdit;

    Bevel6: TBevel;

    Label8: TLabel;

    Label9: TLabel;

    Edit1: TEdit;

    TrackBar1: TTrackBar;

    TrackBar2: TTrackBar;

    Label1: TLabel;

    Label2: TLabel;

    Label3: TLabel;

    Label4: TLabel;

    Label5: TLabel;

    Bevel4: TBevel;

    Bevel5: TBevel;

    Bevel7: TBevel;

    Label6: TLabel;

    Bevel8: TBevel;

    Edit2: TEdit;

    Edit3: TEdit;

    Edit4: TEdit;

    Edit5: TEdit;

    Edit6: TEdit;

    Edit8: TEdit;

    Label7: TLabel;

    Label10: TLabel;

    Label11: TLabel;

    Label12: TLabel;

    Label13: TLabel;

    Label14: TLabel;

    Bevel9: TBevel;

    Bevel10: TBevel;

    N01: TMenuItem;

    Label15: TLabel;

    Bevel11: TBevel;

    CheckBox1: TCheckBox;

    

    procedure BitBtn1Click(Sender: TObject);

    procedure TrackBar1Change(Sender: TObject);

    procedure TrackBar2Change(Sender: TObject);

    procedure FormCreate(Sender: TObject);

    procedure FormDestroy(Sender: TObject);

    procedure CheckBox1Click(Sender: TObject);

    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,

      Y: Integer);

 

 

 

 

 

    //procedure BitBtn2Click(Sender: TObject);

   

 

 

 

 

  

  private

    { Private declarations }

  public

    { Public declarations }

  end;

 

var

  Form1: TForm1;

  i,time,time1,j,x,xx,H,Fmax,Fmin,L,D,beta,n,{//}Fmax2,Fmin2,L2,D2,beta2,nn,H2:integer;

   CritSec:TCriticalSection;

implementation

 

uses Unit2;

 

{$R *.dfm}

 

procedure threadm;                    ПРОРИСОВКА 1 КРУГА

begin

PatBlt(Form1.image1.Canvas.Handle, 0, 0, Form1.ClientWidth, Form1.ClientHeight, WHITENESS);

for i:=0 to 100 do

begin

 

n:=n+i;

H:=350;

Fmax:=strtoint(form1.Edit2.Text);

Fmin:=strtoint(form1.Edit3.Text);

beta:=strtoint(form1.Edit4.Text);

L:=round(H*Fmax/(2*tan(beta/57)*fmin));

D:=round(H*L/(20*(L-n)));

x:=form1.trackbar1.Position;

Application.ProcessMessages;

form1.image1.Canvas.Brush.Color:=clgreen;

form1.image1.Canvas.Ellipse(260-D-x,175-D-x,260+D+x,175+D+x);

time:=strtoint(form1.edit7.Text);

sleep(time);

if d+x>=round(176*0.8) then break;

 

CritSec.Leave;

end;

 

endthread(0);

end;

 

 

procedure threadmm;  2 КРУГА 

begin

PatBlt(Form1.image2.Canvas.Handle, 0, 0, Form1.ClientWidth, Form1.ClientHeight, WHITENESS);

for j:=0 to 100 do

begin

 

nn:=nn+j;

H2:=350;

Fmax2:=strtoint(form1.Edit5.Text);

Fmin2:=strtoint(form1.Edit6.Text);

beta2:=strtoint(form1.Edit8.Text);

L2:=round(H2*Fmax2/(2*tan((beta2)/57)*fmin2));

D2:=round(H2*L2/(20*(L2-nn)));

xx:=form1.trackbar2.Position;

Application.ProcessMessages;

form1.image2.Canvas.Brush.Color:=clgreen;

form1.image2.Canvas.Ellipse(260-d2-xx,175-d2-xx,260+d2+xx,175+d2+xx);

time1:=strtoint(form1.edit1.Text);

sleep(time1);

if D2+xx>=round(176*0.8) then break;

CritSec.Leave;

form1.label15.Caption:=floattostr(roundto((d+0.001)/(d2+0.001)-0.25,-2));

 form1.n01.Caption:=floattostr(roundto((time+0.001)/(time1+0.001),-2))

end;

 

endthread(0);

end;

 

 

procedure TForm1.BitBtn1Click(Sender: TObject);

var tid1,tid2,id:longword;

begin

 

 

PatBlt(Form1.image2.Canvas.Handle, 0, 0, Form1.ClientWidth, Form1.ClientHeight, WHITENESS);

PatBlt(Form1.image1.Canvas.Handle, 0, 0, Form1.ClientWidth, Form1.ClientHeight, WHITENESS);

i:=0;

j:=0;

tid1:=beginthread(nil,0,Addr(threadm),nil,0,id);

tid2:=beginthread(nil,0,Addr(threadmm),nil,0,id);

 

DoubleBuffered := true;

 

 

 

end;

 

 

 

procedure TForm1.TrackBar1Change(Sender: TObject);

var x:integer;

begin

PatBlt(Form1.image1.Canvas.Handle, 0, 0, Form1.ClientWidth, Form1.ClientHeight, WHITENESS);

x:=trackbar1.Position;

form1.image1.Canvas.Brush.Color:=clgreen;

form1.image1.Canvas.Ellipse(260-x,175-x,260+x,175+x);

label1.Caption:=inttostr(x);

end;

 

procedure TForm1.TrackBar2Change(Sender: TObject);

var xx:integer;

begin

PatBlt(Form1.image2.Canvas.Handle, 0, 0, Form1.ClientWidth, Form1.ClientHeight, WHITENESS);

xx:=trackbar2.Position;

form1.image2.Canvas.Brush.Color:=clgreen;

form1.image2.Canvas.Ellipse(260-xx,175-xx,260+xx,175+xx);

label2.Caption:=inttostr(xx);

end;

 

 

 

procedure TForm1.FormCreate(Sender: TObject);

begin

CritSec:=TCriticalSection.Create;

 

end;

 

procedure TForm1.FormDestroy(Sender: TObject);

begin

CritSec.Free; // разрушаем

end;

 

 

 

 

 

procedure TForm1.CheckBox1Click(Sender: TObject);

begin

label15.Visible:=true;

end;

 

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,

  Y: Integer);

begin

checkbox1.Checked:=false;

label15.Visible:=false;

end;

 

end.

08.01.11
3 ответа

Ответы

Скорее всего эта где-то неправильно записана команда.проверьте правильность написания команд.Есл что обращайтесь!

03.02.11

Было бы неплохо написать, на какой строчке в отладчике вываливается программа. И что при этом пишется.

28.04.11

В чат заходите. И вышлите архив проекта на leo28@nm.ru

03.12.11
Посмотреть всех экспертов из раздела Технологии > Delphi
Пользуйтесь нашим приложением Доступно на Google Play Загрузите в App Store