Эффект плавного перехода
...существует ли для этого эффекта какой-либо алгоритм генерации изображений вместо использования кисточки?
Я был скептически настроен к механизму использования кистей, чтобы получить что-либо похожее на эффект перехода/ухода ("fade") по сравнению со стеркой ("wipe"), но вчера вечером я нашел следующее решение, которое делает невероятное - осуществляет плавный переход от одного изображения к другому:
procedure WaitAWhile(n: longint); var StartTime: longint; begin StartTime := timeGetTime; while timeGetTime < StartTime + n do ; end; procedure TForm1.Image1Click(Sender: TObject); var BrushBmp, BufferBmp, Buffer2Bmp, ImageBmp, Image2Bmp: TBitmap; j, k, row, col: longint; begin row := 0; col := 0; BrushBmp := TBitmap.Create; with BrushBmp do begin Monochrome := false; Width := 8; Height := 8; end; imageBmp := TBitmap.create; imagebmp.loadfromfile('c:\huh.bmp'); image2bmp := TBitmap.Create; image2bmp.LoadFromFile('c:\whatsis.bmp'); {При 256 цветах лучше иметь ту же самую палитру!} BufferBmp := TBitmap.Create; with BufferBmp do begin Height := 200; Width := 200; canvas.brush.bitmap := TBitmap.Create; end; Buffer2Bmp := TBitmap.Create; with Buffer2Bmp do begin Height := 200; Width := 200; canvas.brush.bitmap := TBitmap.Create; end; for k := 1 to 16 do begin WaitAWhile(0); {Для пентиума необходимо добавить задержку} for j := 0 to 3 do begin row := (row + 5) mod 8; col := (col + 1) mod 8; if row = 0 then col := (col + 1) mod 8; BrushBmp.canvas.Pixels[row, col] := clBlack; end; with BufferBmp do begin canvas.copymode := cmSrcCopy; canvas.brush.bitmap.free; canvas.brush.style := bsClear; canvas.brush.bitmap := TBitmap.Create; canvas.brush.bitmap.Assign(BrushBmp); canvas.Rectangle(0, 0, 200, 200); canvas.CopyMode := cmMergeCopy; canvas.copyrect(rect(0, 0, 200, 200), imageBmp.canvas, rect(0, 0, 200, 200)); end; with Buffer2Bmp do begin canvas.copymode := cmSrcCopy; canvas.brush.bitmap.free; canvas.brush.style := bsClear; canvas.brush.bitmap := TBitmap.Create; canvas.brush.bitmap.Assign(BrushBmp); canvas.Rectangle(0, 0, 200, 200); canvas.copymode := cmSrcErase; canvas.copyrect(rect(0, 0, 200, 200), image2bmp.canvas, rect(0, 0, 200, 200)); end; BufferBmp.Canvas.CopyMode := cmSrcPaint; BufferBmp.Canvas.Copyrect(rect(0, 0, 200, 200), Buffer2Bmp.Canvas, rect(0, 0, 200, 200)); canvas.copymode := cmSrcCopy; canvas.copyrect(rect(0, 0, 200, 200), BufferBmp.Canvas, rect(0, 0, 200, 200)); end; BufferBmp.canvas.brush.bitmap.free; Buffer2Bmp.canvas.brush.bitmap.free; BrushBmp.Free; BufferBmp.Free; Buffer2Bmp.Free; ImageBmp.Free; image2Bmp.Free; end;
Комментарии: На Pentium I я реально использую 64 кисточки, изменив приведенные выше строки на следующие:
for k:= 1 to 64 do begin WaitAWhile(50); for j:=0 to 0 do
При организации указанной задержки возможно получение плавного перехода.
Заполняя кисть в другом порядке, вы можете получить ряд других эффектов, но приведенная выше версия единственная, которую мне удалось получить максимально похожей на эффект перехода, но вы можете, скажем, написать:
begin row:=(row+1) mod 8; (*col:=(col+1) mod 8;*) if row=0 then col:=(col+1) mod 8;
и получить своего рода эффект перехода типа "venetian-blind wipe" (дословно - стерка венецианского хрусталя).
Вопрос: Я чуствую, что я делаю что-то неправильно, существует какая-то хитрость с кистью. Мне нужно все четыре строчки:
canvas.brush.bitmap.free; canvas.brush.style:=bsClear; canvas.brush.bitmap:=TBitmap.Create; canvas.brush.bitmap.Assign(BrushBmp);
чтобы все работало правильно; но я совсем не понимаю, почему первые три строки являются обязательными, но если я их выкидываю, Assign сработывает только один раз(!?!?!). Это реально работает? Есть способ другого быстрого назначения brush.bitmaps? (В документации в качестве примера указано на Brush.Bitmap.LoadFromFile, но должно быть лучшее решение. Хорошо, допустим приведенный способ лучший, но он кажется неправильным...)
Взято с https://delphiworld.narod.ru