OSDN Git Service

ReSize 2048 x 1536 master
authoryamat0jp <yamat0jp@yahoo.co.jp>
Fri, 28 Jul 2017 21:02:41 +0000 (06:02 +0900)
committeryamat0jp <yamat0jp@yahoo.co.jp>
Fri, 28 Jul 2017 21:02:41 +0000 (06:02 +0900)
Unit1.fmx
Unit1.pas
cam.dproj

index 8fd86bf..5121efc 100644 (file)
--- a/Unit1.fmx
+++ b/Unit1.fmx
@@ -15,6 +15,7 @@ object Form1: TForm1
       item
       end>
     Align = Right
+    Anchors = [akLeft, akTop, akRight, akBottom]
     Position.X = 184.000000000000000000
     Size.Width = 456.000000000000000000
     Size.Height = 480.000000000000000000
index 0604ec5..1e89602 100644 (file)
--- a/Unit1.pas
+++ b/Unit1.pas
@@ -45,10 +45,10 @@ var
 procedure TForm1.Button2Click(Sender: TObject);
 begin
   case ac of
-  push, shot:
-    th.Terminate;
-  keep:
-    Exit;
+    push, shot:
+      th.Terminate;
+    keep:
+      Exit;
   end;
   ac := push;
   th := TCamThread.Create;
@@ -61,6 +61,7 @@ var
   s: string;
   a, b, c, d, e, dd, hh, mm: Word;
   bmp: TBitmap;
+  r1, r2: TRectF;
 begin
   case ac of
     ready, push:
@@ -68,10 +69,15 @@ begin
     shot:
       begin
         ac := keep;
+        CameraComponent1.SampleBufferToBitmap(Image1.Bitmap, true);
         bmp := TBitmap.Create;
         try
-          CameraComponent1.SampleBufferToBitmap(bmp, true);
-          Image1.Bitmap.Assign(bmp);
+          bmp.SetSize(2048, 1536);
+          r1 := TRectF.Create(0, 0, Image1.Bitmap.Width, Image1.Bitmap.Height);
+          r2 := TRectF.Create(0, 0, bmp.Width, bmp.Height);
+          bmp.Canvas.BeginScene;
+          bmp.Canvas.DrawBitmap(Image1.Bitmap, r1, r2, 100);
+          bmp.Canvas.EndScene;
           DecodeDateTime(Now, a, b, dd, hh, d, e, mm);
           s := ExtractFilePath(ParamStr(0)) + Format('%d_%d_%d', [dd, hh, mm]);
           bmp.SaveToFile(s + '.jpg');
index 2ac8b2e..0a20c4c 100644 (file)
--- a/cam.dproj
+++ b/cam.dproj
@@ -5,7 +5,7 @@
         <FrameworkType>FMX</FrameworkType>
         <MainSource>cam.dpr</MainSource>
         <Base>True</Base>
-        <Config Condition="'$(Config)'==''">Debug</Config>
+        <Config Condition="'$(Config)'==''">Release</Config>
         <Platform Condition="'$(Platform)'==''">Win32</Platform>
         <TargetedPlatforms>95</TargetedPlatforms>
         <AppType>Application</AppType>