From 4d64e4cd434426234a5c313c151cd79b6afc299e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Juha=20Vehvil=C3=A4inen?= Date: Sat, 6 Jul 2002 17:50:18 +0000 Subject: *** empty log message *** svn path=/trunk/Framestein/; revision=27 --- Source/fscopyunit.pas | 349 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 349 insertions(+) create mode 100644 Source/fscopyunit.pas (limited to 'Source/fscopyunit.pas') diff --git a/Source/fscopyunit.pas b/Source/fscopyunit.pas new file mode 100644 index 0000000..0206d8f --- /dev/null +++ b/Source/fscopyunit.pas @@ -0,0 +1,349 @@ +{ Copyright (C) 2001 Juha Vehviläinen + This program is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public License + as published by the Free Software Foundation; either version 2 + of the License, or (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details.} + +unit fscopyunit; + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + mainunit, fsformunit, fsframeunit, StdCtrls, C2PhotoShopHost; + +type + TDrawStyles = (dsCopy, dsROP, dsAlpha, dsAdd, dsSub, + dsBlend, dsPlugin, dsFilter); + TRectTypes = (rtAll, rtRandom, rtSpecific); + + Tfscopy = class(TFsForm) + copypsh: TC2PhotoShopHost; + procedure FormClose(Sender: TObject; var Action: TCloseAction); + procedure FormCreate(Sender: TObject); + private + { Private declarations } + f1, f2: TFsFrame; + DrawStyle: TDrawStyles; + dsROPMode: Integer; + SourceType: TRectTypes; + DestType: TRectTypes; + SourceRect, DestRect: TRect; + iAlpha, iAdd, iSub: Integer; + iBlend: Extended; + Transparent, MirrorLeftRight, MirrorUpdown: Boolean; + iPlugin, iPluginArgs: String; + iFilter, iFilterArgs: String; + + procedure GetFrames(const S: String); + public + { Public declarations } + procedure Parse(const S: String); override; + end; + +var + fscopy: Tfscopy; + +implementation + +{$R *.DFM} + +uses + DxDraws, DirectX, + effectsunit, fsbrowserunit, pshostunit, + Strz; + +procedure Tfscopy.FormClose(Sender: TObject; var Action: TCloseAction); +begin + Action := caFree; +end; + +procedure Tfscopy.GetFrames(const S: String); +const + f1name: String = '-1'; + f2name: String = '-1'; +var + s1, s2: String; +begin + if (Pos(' ', S)=0) then Exit; + + s1 := UpperCase(ExtractWord(1, S, [' '])); + s2 := UpperCase(ExtractWord(2, S, [' '])); + + if (s1<>f1name) or (f1=nil) then + f1 := FindFrame(s1); + + if (s2<>f2name) or (f2=nil) then + f2 := FindFrame(s2); + + f1name := s1; f2name := s2; +end; + +procedure Tfscopy.Parse(const S: String); + + procedure SwapInt(var i1, i2: Integer); + var + tmpi: Integer; + begin + tmpi := i1; + i1 := i2; + i2 := tmpi; + end; + +var + s1: String; + bltFlags: Cardinal; + df: TDDBltFX; + ddck: TDDColorKey; + sx1, sy1, sx2, sy2, dx1, dy1, dx2, dy2: Integer; +begin + if (S='') then Exit; + + s1 := UpperCase(ExtractWord(1, S, [' '])); + + if Pos('FS.FRAME', s1)=0 then + if s1='COPY' then begin DrawStyle := dsCopy; Exit; end else + if s1='BLEND' then begin + DrawStyle := dsBlend; + iBlend := MyStrToFloat(ExtractWord(2, S, [' '])); + Exit; + end else + if s1='ALPHA' then begin + DrawStyle := dsAlpha; + iAlpha := MyStrToInt(ExtractWord(2, S, [' '])); + Exit; + end else + if s1='ADD' then begin + DrawStyle := dsAdd; + iAdd := MyStrToInt(ExtractWord(2, S, [' '])); + Exit; + end else + if s1='SUB' then begin + DrawStyle := dsSub; + iSub := MyStrToInt(ExtractWord(2, S, [' '])); + Exit; + end else + if s1='SOURCE' then begin + if Pos(' ', S)>0 then begin // at least x1 specified + SourceRect := StrToRect(Copy(S, Length(s1)+2, 255)); + SourceType := rtSpecific; + Exit; + end; + end else + if s1='DEST' then begin + if Pos(' ', S)>0 then begin // at least x1 specified + DestRect := StrToRect(Copy(S, Length(s1)+2, 255)); + DestType := rtSpecific; + Exit; + end; + end else + if s1='SOURCE_ALL' then begin SourceType := rtAll; Exit; end else + if s1='SOURCE_RANDOM' then begin SourceType := rtRandom; Exit; end else + if s1='DEST_ALL' then begin DestType := rtAll; Exit; end else + if s1='DEST_RANDOM' then begin DestType := rtRandom; Exit; end else + + if s1='BLACKNESS' then begin DrawStyle := dsROP; dsROPMode := cmBlackness; Exit; end else + if s1='DSTINVERT' then begin DrawStyle := dsROP; dsROPMode := cmDstInvert; Exit; end else + if s1='MERGECOPY' then begin DrawStyle := dsROP; dsROPMode := cmMergeCopy; Exit; end else + if s1='MERGEPAINT' then begin DrawStyle := dsROP; dsROPMode := cmMergePaint; Exit; end else + if s1='NOTSRCCOPY' then begin DrawStyle := dsROP; dsROPMode := cmNotSrcCopy; Exit; end else + if s1='NOTSRCERASE' then begin DrawStyle := dsROP; dsROPMode := cmNotSrcErase; Exit; end else + if s1='PATCOPY' then begin DrawStyle := dsROP; dsROPMode := cmPatCopy; Exit; end else + if s1='PATINVERT' then begin DrawStyle := dsROP; dsROPMode := cmPatInvert; Exit; end else + if s1='PATPAINT' then begin DrawStyle := dsROP; dsROPMode := cmPatPaint; Exit; end else + if s1='SRCAND' then begin DrawStyle := dsROP; dsROPMode := cmSrcAnd; Exit; end else + if s1='SRCCOPY' then begin DrawStyle := dsROP; dsROPMode := cmSrcCopy; Exit; end else + if s1='SRCERASE' then begin DrawStyle := dsROP; dsROPMode := cmSrcErase; Exit; end else + if s1='SRCINVERT' then begin DrawStyle := dsROP; dsROPMode := cmSrcInvert; Exit; end else + if s1='SRCPAINT' then begin DrawStyle := dsROP; dsROPMode := cmSrcPaint; Exit; end else + if s1='WHITENESS' then begin DrawStyle := dsROP; dsROPMode := cmWhiteness; Exit; end else + + if s1='TRANSPARENT_0' then begin Transparent := False; Exit; end else + if s1='TRANSPARENT_1' then begin Transparent := True; Exit; end else + if s1='MIRRORLEFTRIGHT_0' then begin MirrorLeftRight := False; Exit; end else + if s1='MIRRORLEFTRIGHT_1' then begin MirrorLeftRight := True; Exit; end else + if s1='MIRRORUPDOWN_0' then begin MirrorUpDown := False; Exit; end else + if s1='MIRRORUPDOWN_1' then begin MirrorUpDown := True; Exit; end else + if main.Plugins.IsPlugin(s1) then begin + DrawStyle := dsPlugin; + iPlugin := s1; + iPluginArgs := Copy(S, Length(s1)+2, 255); + Exit; + end else + if pshostunit.IsFilter(s1) then begin + DrawStyle := dsFilter; + iFilter := s1; + iFilterArgs := Copy(S, Length(s1)+2, 255); + Exit; + end; + + + GetFrames(S); + if (f1=nil) or (f2=nil) then Exit; + if (f1.d1=nil) or (f2.d1=nil) then Exit; + + if (f1.ParentWindow>0) and not IsWindow(f1.ParentWindow) then Exit; + if (f2.ParentWindow>0) and not IsWindow(f2.ParentWindow) then Exit; + + if f1 is TFsBrowser then begin + (f1 as TFsBrowser).CopyToSurface; + end; + + case SourceType of + rtAll: begin + sx1 := 0; + sy1 := 0; + sx2 := f1.d1.Surface.Width; + sy2 := f1.d1.Surface.Height; + end; + rtRandom: begin + sx1 := Random(f1.d1.Surface.Width); + sx2 := Random(f1.d1.Surface.Width); + sy1 := Random(f1.d1.Surface.Height); + sy2 := Random(f1.d1.Surface.Height); + end; + rtSpecific: begin + sx1 := SourceRect.Left; + sy1 := SourceRect.Top; + sx2 := SourceRect.Right; + sy2 := SourceRect.Bottom; + end; + end; + + case DestType of + rtAll: begin + dx1 := 0; + dy1 := 0; + dx2 := f2.d1.Surface.Width; + dy2 := f2.d1.Surface.Height; + end; + rtRandom: begin + dx1 := Random(f2.d1.Surface.Width); + dx2 := Random(f2.d1.Surface.Width); + dy1 := Random(f2.d1.Surface.Height); + dy2 := Random(f2.d1.Surface.Height); + end; + rtSpecific: begin + dx1 := DestRect.Left; + dy1 := DestRect.Top; + dx2 := DestRect.Right; + dy2 := DestRect.Bottom; + end; + end; + + if sx2f1.d1.Surface.Width then sx2:=f1.d1.Surface.Width; + if sy2>f1.d1.Surface.Height then sy2:=f1.d1.Surface.Height; + if dx1<0 then dx1:=0; + if dy1<0 then dy1:=0; + if dx2>f2.d1.Surface.Width then dx2:=f1.d1.Surface.Width; + if dy2>f2.d1.Surface.Height then dy2:=f2.d1.Surface.Height; + + case DrawStyle of + dsCopy: begin + ddck.dwColorSpaceLowValue := 0; + ddck.dwColorSpaceHighValue := 0; + DF.dwsize := SizeOf(DF); + DF.dwROP := cmSrcCopy; + DF.dwDDFX := 0; + DF.ddckSrcColorkey := ddck; + DF.ddckDestColorkey := ddck; + bltFlags := DDBLT_DDFX; + if Transparent then bltFlags := bltFlags or DDBLT_KEYSRCOVERRIDE; + if MirrorLeftRight then + DF.dwDDFX := DF.dwDDFX or DDBLTFX_MIRRORLEFTRIGHT; + if MirrorUpDown then + DF.dwDDFX := DF.dwDDFX or DDBLTFX_MIRRORUPDOWN; + + if not f2.d1.Surface.Blt( + Rect(dx1, dy1, dx2, dy2), + Rect(sx1, sy1, sx2, sy2), + bltFlags or {DDBLT_ROP or} DDBLT_WAIT, + DF, f1.d1.Surface ) then + main.Post(Self.Name+': blt failed.') + else + f2.FlipRequest; + end; + dsROP: begin + StretchBlt(f2.d1.Surface.Canvas.Handle, + dx1, dy1, dx2-dx1, dy2-dy1, + f1.d1.Surface.Canvas.Handle, + sx1, sy1, sx2-sx1, sy2-sy1, dsROPMode); + + f1.d1.Surface.Canvas.Release; + f2.d1.Surface.Canvas.Release; + f2.FlipRequest; + end; + dsAlpha: begin + f2.d1.Surface.DrawAlpha( + Rect(dx1, dy1, dx2, dy2), + Rect(sx1, sy1, sx2, sy2), + f1.d1.Surface, False, iAlpha); + f2.FlipRequest; + end; + dsAdd: begin + f2.d1.Surface.DrawAdd( + Rect(dx1, dy1, dx2, dy2), + Rect(sx1, sy1, sx2, sy2), + f1.d1.Surface, False, iAdd); + f2.FlipRequest; + end; + dsSub: begin + f2.d1.Surface.DrawSub( + Rect(dx1, dy1, dx2, dy2), + Rect(sx1, sy1, sx2, sy2), + f1.d1.Surface, False, iSub); + f2.FlipRequest; + end; + dsBlend: begin + blend(f1.d1.Surface, f2.d1.Surface, iBlend); + f2.FlipRequest; + end; + dsPlugin: begin + if main.Plugins.CallCopy(f1.d1.Surface, f2.d1.Surface, + iPlugin, iPluginArgs) then begin + f1.FlipRequest; + f2.FlipRequest; + end; + end; + dsFilter: begin + if pshostunit.Filter_copy(Self.copypsh, + f1.d1.Surface, f2.d1.Surface, + iFilter, iFilterArgs) then begin + f1.FlipRequest; + f2.FlipRequest; + end; + end; + end; +end; + +procedure Tfscopy.FormCreate(Sender: TObject); +begin + f1 := nil; f2 := nil; + DrawStyle := dsCopy; + SourceType := rtAll; + DestType := rtAll; + iAlpha := 50; iAdd := 255; iSub := 255; + Transparent := False; + MirrorLeftRight := False; + MirrorUpDown := False; +end; + +end. + -- cgit v1.2.1