tthread замучил

← →
Maxim____ (2004-11-05 10:48) [0]

Загрузку превьюшек написана в потоке,
потому что открытие большого файла занимет много времени.
но как только двинешь мышкой, всё рушится,
битмапы то белые то никакие.
для того чтобы понять что с битмапом, пытался
сохранить его в цикле в файл,
получаю сообщение что такой файл уже есть,
хотя его нет, и вылет.
Всё что можно было вынести в synchronize вынес,
что ж ещё и загрузку картинки туда же вынести?
тогда какой смысл в потоке?
или что из-за этих битмапов создавать criticalsection?
Столько суеты из-за bm.loadfromfile.

Скажите, как быть?
Третий день получаю белые битмапы и ничего не могу понять.

type tloadimages = class(TThread)
ii: integer;
iW, iH: integer;
tempbmin, tempbmout: tbitmap;
sfm, sthfm, wthfm: string;
oimgW, oimgH: integer;
private

protected
procedure Execute; override;
procedure imgHandling;
procedure fillVars;
end;

procedure tloadimages.Execute;
var i: integer;
begin
for i := 0 to high(imgs) do begin
ii := i;
synchronize(fillvars);
tempbmin := tbitmap.Create;
tempbmin.PixelFormat := pf24bit;
tempbmout := tbitmap.Create;
tempbmout.PixelFormat := pf24bit;
loadbitmapfromfile(tempbmin, sfm);
// tempbmin.savetofile("c:\temp\"+inttostr(i)+".bmp");
decreaseimage(tempbmin, tempbmout, oimgW, oimgH);
tempbmout.SaveToFile(sthfm);
tempbmout.SaveToFile(wthfm);
iW := tempbmIn.Width;
iH := tempbmIn.Height;

synchronize(imgHandling);
tempbmin.Free;
tempbmout.Free;
if terminated then break;
end;
end;

procedure tloadimages.fillVars;
begin
sfm := imgs[ii].sourceFM;
sthfm := imgs[ii].sourceTHfm;
wthfm := imgs[ii].workcopyTHfm;
oimgW := form1.oimage.width;
oimgH := form1.oimage.height;
end;

procedure tloadimages.imgHandling;
var r: trect;
w, h: integer;
begin
with imgs[ii] do begin
image.picture.bitmap.Assign(tempbmout);
imgW := iW;
imgH := iH;
w := image.picture.Width;
h := image.picture.Height;
r.Left := (panel.Width - w) div 2;
r.Top := ((form1.oimage.boundsrect.Bottom - form1.oimage.top) - h) div 2 + form1.oimage.Top;
r.Right := r.left + w;
r.Bottom := r.Top + h;
image.Picture.Bitmap.PixelFormat := pf24bit;
image.BoundsRect := r;
image.Show;
panel.show;
panel.Invalidate;
end;
end;

← →
Maxim____ (2004-11-05 11:20) [1]

tempbmin.PixelFormat := pf24bit
вроде не safe
убрал везде,
пробовал criticalsection
ничего не помогает!
help!

← →
kaZaNoVa © (2004-11-05 11:28) [2]

Maxim____ (05.11.04 11:20) [1]
у меня тоже были косяки в связке Thread & VCL .. забил .. перешёл на апи . :)

← →
Maxim____ (2004-11-05 13:18) [3]

т.е. вы предлагаете мне загрузку картинки на низком уровне писать?
это сильно усложняет задачу.
а зачем тогда tthread?

← →
kaZaNoVa © (2004-11-05 13:47) [4]

Maxim____ (05.11.04 13:18) [3]
не .. я не это имел ввиду .. просто я тогда эту проблему так и не решил и забил на неё ;)

← →
Maxim____ (2004-11-05 14:07) [5]

я не могу забить на проблему, проблему необходимо решить.

как же мне быть?
писать tbitmap.loadfromfile и
(tjpegimage,ttiffimage).loadfromfile
руками очень сложно,
просто не хватит времени,
может быть можно заставить работать tthread?

← →
Maxim____ (2004-11-05 15:15) [6]

написал:
tempbmin.Canvas.Lock; loadbitmapfromfile(tempbmin, sfm); tempbmin.Canvas.Unlock;

и проблема исчезла, теперь и при двигании мыши
всё грузится нормально.
БРЕД! какое основному потоку дело до скрытого битмапа???
я всегда думал что canvas.lock - необходимая вещь для визуальных компонентов, но для скрытого битмапа - зачем?????

← →
Maxim____ (2004-11-05 18:04) [7]

народ! где же ваши соображения по теме?
проблемы конечно нет,
но такого быть не должно!

← →
Maxim____ (2004-11-05 19:42) [8]

может быть я в маразме
и то о чём я пытаюсь с вами говорить
не актуально или слишком очевидно???
напишите же хоть что-нибудь в ответ

Maxim____ (05.11.04 19:42) [8]

> напишите же хоть что-нибудь в ответ

:)))
написал ;)))

> народ! где же ваши соображения по теме?

А какие тут соображения, вы рассказываете какие-то небылицы.
Убедитесь сами:

unit ThreadtestUI; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls; type TForm1 = class(TForm) Image1: TImage; Button1: TButton; OpenDialog1: TOpenDialog; procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } procedure PreviewBitmap( Sender: TObject); end; TLoader = class(TThread) private bmp : TBitmap; FFileName : TFileName; protected procedure Execute;override; public property Bitmap: TBitmap read bmp; constructor Create(AFileName: TFileName); end; var Form1: TForm1; implementation {$R *.dfm} constructor TLoader.Create; begin FFileName := AFileName; FreeOnTerminate := True; inherited Create(True); end; procedure TLoader.Execute; begin Bmp := TBitmap.Create; Try Bmp.LoadFromFile( FFileName ); if Assigned(OnTerminate) then OnTerminate(Self) Finally OnTerminate := nil; Bmp.Free; End; end; procedure TForm1.PreviewBitmap; begin if Sender is TLoader then with TLoader(Sender) do if Assigned(Bitmap) then Image1.Canvas.StretchDraw(Image1.ClientRect, Bitmap); end; procedure TForm1.Button1Click(Sender: TObject); begin if OpenDialog1.Execute then begin with TLoader.Create( OpenDialog1.FileName ) do begin OnTerminate := PreviewBitmap; Resume; end; end; end; end.

DFM к модулю [10]

object Form1: TForm1 Left = 173 Top = 152 Width = 672 Height = 498 Caption = "Form1" Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = "MS Sans Serif" Font.Style = [] OldCreateOrder = False PixelsPerInch = 96 TextHeight = 13 object Image1: TImage Left = 8 Top = 8 Width = 433 Height = 457 end object Button1: TButton Left = 456 Top = 8 Width = 75 Height = 25 Caption = "Button1" TabOrder = 0 OnClick = Button1Click end object OpenDialog1: TOpenDialog Filter = "Bitmap|*.bmp" Left = 456 Top = 48 end end

Немного подправил модуль, так будет правильнее:

unit ThreadtestUI; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls; type TForm1 = class(TForm) Image1: TImage; Button1: TButton; OpenDialog1: TOpenDialog; procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } procedure PreviewBitmap( Sender: TObject); end; TLoader = class(TThread) private bmp : TBitmap; FFileName : TFileName; procedure SyncOnTerminate; protected procedure Execute;override; public property Bitmap: TBitmap read bmp; constructor Create(AFileName: TFileName); end; var Form1: TForm1; implementation {$R *.dfm} constructor TLoader.Create; begin FFileName := AFileName; FreeOnTerminate := True; inherited Create(True) end; procedure TLoader.SyncOnTerminate; begin if Assigned(OnTerminate) then OnTerminate(Self) end; procedure TLoader.Execute; begin Bmp := TBitmap.Create; try Bmp.LoadFromFile( FFileName ); Synchronize( SyncOnTerminate ) finally OnTerminate := nil; Bmp.Free end end; procedure TForm1.PreviewBitmap; begin if Sender is TLoader then with TLoader(Sender) do if Assigned(Bitmap) then Image1.Canvas.StretchDraw(Image1.ClientRect, Bitmap) end; procedure TForm1.Button1Click(Sender: TObject); begin if OpenDialog1.Execute then begin with TLoader.Create( OpenDialog1.FileName ) do begin OnTerminate := PreviewBitmap; Resume end end end; end.

tthread замучил Найти похожие ветки