( код во вложении)
По виндой работает на ура, а пересобираю под linux слетает после пару записей
правда пришлось добавлять две строки чтобы собрать под LInux в файл проекта
иначе не компилился
program big_spoon;
{$mode objfpc}{$H+}
//********* кусок под линукс
{$DEFINE UNIX}
{$DEFINE UseCThreads}
//*****
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms
{ you can add units after this }, unitpass, unitgl, DBFLaz, MemDSLaz, unitopl,
zcomponent, SQLDBLaz, unitconf, unitlog, unitupdate;
begin
Application.Initialize;
Application.CreateForm(Tmainform, mainform);
Application.CreateForm(Tpassform, passform);
Application.Run;
end.
Поток определяю
TSyncThread = class(TThread)
private
Progress: integer;
procedure SetProgress;
procedure endpotok;
protected
procedure Execute; override;
end;
procedure TSyncThread.Execute;
begin
kol:=formupdate.readuser;
formupdate.ProgressBar1.Max :=kol;
formupdate.ProgressBar1.Step:=1;
mainform.tusers.Open;
mainform.tusers.First ;
ii:=0;
try
mainform.tranuserk.StartTransaction ;
while not mainform.tusers.EOF do
begin
ii:=ii+1;
formupdate.writeuser;
sleep(50);
Progress:=ii;
Synchronize(@SetProgress);
mainform.tusers.Next;
end;
ii:=0;
mainform.tranuserk.Commit ;
except
ii:=ii+1;
Application.MessageBox(PChar('Error '),PChar('Error'),MB_ICONERROR );
end;
Synchronize(@endpotok ) ;
end;
//**********************************
procedure TSyncThread.SetProgress;
begin
formupdate.ProgressBar1.Position:=Progress;
end;
procedure Tformupdate.SetProgressPos(var Msg: TLMessage);
begin
case Msg.WParam of
0: ProgressBar1.Position:=Msg.LParam;
end;
end;