Browse Source

bgrabitmap functions and custom functions in bgrascript.pas

lainz 11 years ago
parent
commit
f1455a6265
3 changed files with 293 additions and 38 deletions
  1. 175 8
      bgrascript.pas
  2. 71 1
      test/test_bgrascript/test_bgrascript.lpi
  3. 47 29
      test/test_bgrascript/umain.lfm

+ 175 - 8
bgrascript.pas

@@ -43,8 +43,28 @@ begin
     Add('FillTransparent');
     Add('Rectangle 0,0,100,100,"rgba(0,0,0,1)","rgba(255,255,255,1)","dmDrawWithTransparency"');
     Add('RectangleAntiAlias "0,5","0,5","99,5","99,5","rgba(0,0,0,1)","1,5","rgba(255,255,255,1)"');
+    {BGRA bitmap functions}
+    Add('RotateCW');
+    Add('RotateCCW');
+    Add('Negative');
+    Add('NegativeRect 0,0,100,100');
+    Add('LinearNegative');
+    Add('LinearNegativeRect 0,0,100,100');
+    Add('InplaceGrayscale');
+    Add('InplaceGrayscaleRect 0,0,100,100');
+    Add('SwapRedBlue');
+    Add('GrayscaleToAlpha');
+    Add('AlphaToGrayscale');
+    Add('ApplyGlobalOpacity 128');
+    Add('ConvertToLinearRGB');
+    Add('ConvertFromLinearRGB');
+    Add('DrawCheckers 0,0,100,100,"rgba(100,100,100,255)","rgba(0,0,0,0)"');
     {Custom functions}
-    Add('BlendBitmap 0,0,"file.png","boLinearBlend"');
+    Add('VerticalFlip 0,0,100,100');
+    Add('HorizontalFlip 0,0,100,100');
+    Add('BlendBitmap 0,0,"file.png","boTransparent"');
+    Add('BlendBitmapOver 0,0,"file.png","boTransparent",255,"False"');
+    Add('ApplyBitmapMask "file.png",0,0,100,100,0,0');
   end;
 end;
 
@@ -210,19 +230,166 @@ begin
           StrToFloat(list[6]), StrToBGRA(list[7]));
     end;
 
+    {BGRA bitmap functions}
+    'verticalflip':
+    begin
+      Result := ParamCheck(passed, 5);
+      if Result then
+        bitmap.VerticalFlip(Rect(StrToInt(list[1]), StrToInt(list[2]),
+          StrToInt(list[3]), StrToInt(list[4])));
+    end;
+    'horizontalflip':
+    begin
+      Result := ParamCheck(passed, 5);
+      if Result then
+        bitmap.HorizontalFlip(Rect(StrToInt(list[1]), StrToInt(list[2]),
+          StrToInt(list[3]), StrToInt(list[4])));
+    end;
+    'rotatecw':
+    begin
+      Result := ParamCheck(passed, 1);
+      if Result then
+        try
+          tmpbmp1 := bitmap.RotateCW as TBGRABitmap;
+          bitmap.FillTransparent;
+          bitmap.BlendImage(0, 0, tmpbmp1, boLinearBlend);
+        finally
+          tmpbmp1.Free;
+        end;
+    end;
+    'rotateccw':
+    begin
+      Result := ParamCheck(passed, 1);
+      if Result then
+        try
+          tmpbmp1 := bitmap.RotateCCW as TBGRABitmap;
+          bitmap.FillTransparent;
+          bitmap.BlendImage(0, 0, tmpbmp1, boLinearBlend);
+        finally
+          tmpbmp1.Free;
+        end;
+    end;
+    'negative':
+    begin
+      Result := ParamCheck(passed, 1);
+      if Result then
+        bitmap.Negative;
+    end;
+    'negativerect':
+    begin
+      Result := ParamCheck(passed, 5);
+      if Result then
+        bitmap.NegativeRect(Rect(StrToInt(list[1]), StrToInt(list[2]),
+          StrToInt(list[3]), StrToInt(list[4])));
+    end;
+    'linearnegative':
+    begin
+      Result := ParamCheck(passed, 1);
+      if Result then
+        bitmap.LinearNegative;
+    end;
+    'linearnegativerect':
+    begin
+      Result := ParamCheck(passed, 5);
+      if Result then
+        bitmap.LinearNegativeRect(Rect(StrToInt(list[1]), StrToInt(list[2]),
+          StrToInt(list[3]), StrToInt(list[4])));
+    end;
+    'inplacegrayscale':
+    begin
+      Result := ParamCheck(passed, 1);
+      if Result then
+        bitmap.InplaceGrayscale;
+    end;
+    'inplacegrayscalerect':
+    begin
+      Result := ParamCheck(passed, 5);
+      if Result then
+        bitmap.InplaceGrayscale(Rect(StrToInt(list[1]), StrToInt(list[2]),
+          StrToInt(list[3]), StrToInt(list[4])));
+    end;
+    'swapredblue':
+    begin
+      Result := ParamCheck(passed, 1);
+      if Result then
+        bitmap.SwapRedBlue;
+    end;
+    'grayscaletoalpha':
+    begin
+      Result := ParamCheck(passed, 1);
+      if Result then
+        bitmap.GrayscaleToAlpha;
+    end;
+    'alphatograyscale':
+    begin
+      Result := ParamCheck(passed, 1);
+      if Result then
+        bitmap.AlphaToGrayscale;
+    end;
+    'applyglobalopacity':
+    begin
+      Result := ParamCheck(passed, 2);
+      if Result then
+        bitmap.ApplyGlobalOpacity(StrToInt(list[1]));
+    end;
+    'converttolinearrgb':
+    begin
+      Result := ParamCheck(passed, 1);
+      if Result then
+        bitmap.ConvertToLinearRGB;
+    end;
+    'convertfromlinearrgb':
+    begin
+      Result := ParamCheck(passed, 1);
+      if Result then
+        bitmap.ConvertFromLinearRGB;
+    end;
+    'drawcheckers':
+    begin
+      Result := ParamCheck(passed, 7);
+      if Result then
+        bitmap.DrawCheckers(Rect(StrToInt(list[1]), StrToInt(list[2]),
+          StrToInt(list[3]), StrToInt(list[4])), StrToBGRA(list[5]), StrToBGRA(list[6]));
+    end;
+
     {Custom Functions}
     'blendbitmap':
     begin
       Result := ParamCheck(passed, 5);
       if Result then
-      begin
-        tmpbmp1 := TBGRABitmap.Create(list[3]);
-        bitmap.BlendImage(StrToInt(list[1]), StrToInt(list[2]), tmpbmp1,
-          StrToBlendOperation(list[4]));
-        tmpbmp1.Free;
-      end;
+        try
+          tmpbmp1 := TBGRABitmap.Create(list[3]);
+          bitmap.BlendImage(StrToInt(list[1]), StrToInt(list[2]), tmpbmp1,
+            StrToBlendOperation(list[4]));
+        finally
+          tmpbmp1.Free;
+        end;
+    end;
+    'blendbitmapover':
+    begin
+      Result := ParamCheck(passed, 7);
+      if Result then
+        try
+          tmpbmp1 := TBGRABitmap.Create(list[3]);
+          bitmap.BlendImageOver(StrToInt(list[1]), StrToInt(list[2]),
+            tmpbmp1, StrToBlendOperation(list[4]), StrToInt(list[5]),
+            StrToBool(list[6]));
+        finally
+          tmpbmp1.Free;
+        end;
+    end;
+    'applybitmapmask':
+    begin
+      Result := ParamCheck(passed, 8);
+      if Result then
+        try
+          tmpbmp1 := TBGRABitmap.Create(list[1]);
+          bitmap.ApplyMask(tmpbmp1, Rect(StrToInt(list[2]), StrToInt(
+            list[3]), StrToInt(list[4]), StrToInt(list[5])), Point(
+            StrToInt(list[6]), StrToInt(list[7])));
+        finally
+        end;
     end;
-
 
     '//':
     begin

+ 71 - 1
test/test_bgrascript/test_bgrascript.lpi

@@ -16,8 +16,78 @@
     <VersionInfo>
       <StringTable ProductVersion=""/>
     </VersionInfo>
-    <BuildModes Count="1">
+    <BuildModes Count="3">
       <Item1 Name="Default" Default="True"/>
+      <Item2 Name="Debug">
+        <CompilerOptions>
+          <Version Value="11"/>
+          <PathDelim Value="\"/>
+          <Target>
+            <Filename Value="test_bgrascript"/>
+          </Target>
+          <SearchPaths>
+            <IncludeFiles Value="$(ProjOutDir)"/>
+            <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+          </SearchPaths>
+          <Parsing>
+            <SyntaxOptions>
+              <IncludeAssertionCode Value="True"/>
+            </SyntaxOptions>
+          </Parsing>
+          <CodeGeneration>
+            <Checks>
+              <IOChecks Value="True"/>
+              <RangeChecks Value="True"/>
+              <OverflowChecks Value="True"/>
+              <StackChecks Value="True"/>
+            </Checks>
+          </CodeGeneration>
+          <Linking>
+            <Debugging>
+              <DebugInfoType Value="dsDwarf2Set"/>
+              <UseHeaptrc Value="True"/>
+              <UseExternalDbgSyms Value="True"/>
+            </Debugging>
+          </Linking>
+          <Other>
+            <CompilerMessages>
+              <MsgFileName Value=""/>
+            </CompilerMessages>
+            <CompilerPath Value="$(CompPath)"/>
+          </Other>
+        </CompilerOptions>
+      </Item2>
+      <Item3 Name="Release">
+        <CompilerOptions>
+          <Version Value="11"/>
+          <PathDelim Value="\"/>
+          <Target>
+            <Filename Value="test_bgrascript"/>
+          </Target>
+          <SearchPaths>
+            <IncludeFiles Value="$(ProjOutDir)"/>
+            <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+          </SearchPaths>
+          <CodeGeneration>
+            <SmartLinkUnit Value="True"/>
+            <Optimizations>
+              <OptimizationLevel Value="3"/>
+            </Optimizations>
+          </CodeGeneration>
+          <Linking>
+            <Debugging>
+              <GenerateDebugInfo Value="False"/>
+            </Debugging>
+            <LinkSmart Value="True"/>
+          </Linking>
+          <Other>
+            <CompilerMessages>
+              <MsgFileName Value=""/>
+            </CompilerMessages>
+            <CompilerPath Value="$(CompPath)"/>
+          </Other>
+        </CompilerOptions>
+      </Item3>
     </BuildModes>
     <PublishOptions>
       <Version Value="2"/>

+ 47 - 29
test/test_bgrascript/umain.lfm

@@ -1,35 +1,21 @@
 object Form1: TForm1
-  Left = 542
-  Height = 531
-  Top = 150
-  Width = 1050
+  Left = 428
+  Height = 505
+  Top = 125
+  Width = 1000
   Caption = 'BGRAScript'
-  ClientHeight = 531
-  ClientWidth = 1050
+  ClientHeight = 505
+  ClientWidth = 1000
   OnCreate = FormCreate
   Position = poDesktopCenter
   ShowHint = True
   LCLVersion = '1.2.0.3'
-  object BGRAGraphicControl1: TBGRAGraphicControl
-    Left = 0
-    Height = 232
-    Hint = 'Click to update.'
-    Top = 0
-    Width = 1050
-    Align = alClient
-    OnRedraw = BGRAGraphicControl1Redraw
-    Color = clWhite
-    ColorOpacity = 128
-    Alignment = taCenter
-    OnClick = BGRAGraphicControl1Click
-    Caption = 'BGRAGraphicControl1'
-  end
   inline SynEdit1: TSynEdit
     Left = 0
-    Height = 294
+    Height = 300
     Hint = 'Ctrl + Spacebar to show templates.'
-    Top = 237
-    Width = 1050
+    Top = 205
+    Width = 1000
     Align = alBottom
     Font.Height = -16
     Font.Name = 'Courier New'
@@ -470,19 +456,37 @@ object Form1: TForm1
       '{ BGRAScript }'
       'FillTransparent'
       ''
+      '// Draw rectangles, lines and bitmap'
       'Rectangle 0,0,100,100,"rgba(0,0,0,0.6)","rgba(250,250,250,1)","dmDrawWithTransparency"'
       'Rectangle 20,20,80,80,"rgba(0,0,0,0.4)","rgba(255,255,255,1)","dmDrawWithTransparency"'
+      'SetHorizLine 0,10,98,"rgba(0,0,0,.3)"'
+      'SetVertLine 90,1,98,"rgba(0,0,0,.3)"'
       'BlendBitmap 26,26,"test.png","boTransparent"'
-      'SetHorizLine 1,10,98,"rgba(0,0,0,.3)"'
-      'SetVertLine 10,1,98,"rgba(0,0,0,.3)"'
       ''
+      '// Save and weird things step 1'
       'SaveToFile "file.png"'
+      'Negative'
+      'BlendBitmap 0,100,"file.png","boTransparent"'
       ''
-      'BlendBitmap 100,100,"file.png","boTransparent"'
+      '// Save and weird things step 2'
+      'SaveToFile "file.png"'
+      'Negative'
+      'BlendBitmap 100,0,"file.png","boTransparent"'
       ''
+      '// Flip the world and save it'
+      'VerticalFlip 0,0,100,100'
+      'HorizontalFlip 100,100,200,200'
+      'VerticalFlip 100,0,200,100'
+      'HorizontalFlip 100,0,200,100'
       'SaveToFile "file.png"'
       ''
-      'BlendBitmap 200,0,"file.png","boTransparent"'
+      '// Weird things level 3'
+      'DrawCheckers 200,0,300,300,"rgba(100,100,100,255)","rgba(0,0,0,0)"'
+      'InplaceGrayscaleRect 0,0,100,100'
+      'ApplyBitmapMask "file.png",100,100,200,200,0,100'
+      ''
+      '// Save this in your hard disk (again)'
+      'SaveToFile "file.png"     '
     )
     VisibleSpecialChars = [vscSpace, vscTabAtLast]
     SelectedColor.FrameEdges = sfeAround
@@ -553,11 +557,25 @@ object Form1: TForm1
     Cursor = crVSplit
     Left = 0
     Height = 5
-    Top = 232
-    Width = 1050
+    Top = 200
+    Width = 1000
     Align = alBottom
     ResizeAnchor = akBottom
   end
+  object BGRAGraphicControl1: TBGRAGraphicControl
+    Left = 0
+    Height = 200
+    Hint = 'Click to update.'
+    Top = 0
+    Width = 1000
+    Align = alClient
+    OnRedraw = BGRAGraphicControl1Redraw
+    Color = clWhite
+    ColorOpacity = 128
+    Alignment = taCenter
+    OnClick = BGRAGraphicControl1Click
+    Caption = 'BGRAGraphicControl1'
+  end
   object SynCompletion1: TSynCompletion
     Position = 0
     LinesInWindow = 6