Changeset 10 for trunk/UCore.pas

Timestamp:

Sep 22, 2014, 3:07:02 AM (10 years ago)

Author:

chronos

Message:

• Added: Zooming and moving image.
• Added: Color format 4-bit gray.
• Added: Image operation for generating test gradient image.

File:

• trunk/UCore.pas (modified) (9 diffs)

trunk/UCore.pas

@@ -8 +8 @@
   Classes, SysUtils, FileUtil, ActnList, UProject, UGraphic, Controls, Graphics;
 
+const
+  ZoomFactor = 1.5;
+
 type
+  TFloatPoint = record
+    X, Y: Double;
+  end;
 
   { TCore }
 
   TCore = class(TDataModule)
+    AImageGradient: TAction;
     AImageMirror: TAction;
     AImageFlip: TAction;
@@ -32 +39 @@
     procedure AImageClearExecute(Sender: TObject);
     procedure AImageFlipExecute(Sender: TObject);
+    procedure AImageGradientExecute(Sender: TObject);
     procedure AImageMirrorExecute(Sender: TObject);
     procedure AImageRandomExecute(Sender: TObject);
     procedure AFileNewExecute(Sender: TObject);
+    procedure AZoomAllExecute(Sender: TObject);
     procedure AZoomInExecute(Sender: TObject);
     procedure AZoomNormalExecute(Sender: TObject);
@@ -43 +52 @@
   public
     Project: TProject;
+    procedure Init;
   end;
 
@@ -53 +63 @@
 
 uses
-  UFormNew, UFormMain, Forms, UColorRGBA8, UColorGray8, UColorGray1;
+  UFormNew, UFormMain, Forms, UColorRGBA8, UColorGray8, UColorGray1, UColorGray4;
+
+function FloatPoint(AX, AY: Double): TFloatPoint;
+begin
+  Result.X := AX;
+  Result.Y := AY;
+end;
 
 { TCore }
@@ -63 +79 @@
   ColorManager.RegisterFormat(TGColorFormatRGBA8);
   ColorManager.RegisterFormat(TGColorFormatGray8);
+  ColorManager.RegisterFormat(TGColorFormatGray4);
   ColorManager.RegisterFormat(TGColorFormatGray1);
+end;
 
+procedure TCore.Init;
+begin
   // Set default
   Project.Bitmap.Size := Point(200, 100);
   if ColorManager.FormatCount > 0 then
     Project.Bitmap.ColorFormat := ColorManager.Formats[0];
+  Project.View.DestRect := Bounds(0, 0, FormMain.PaintBox1.Width, FormMain.PaintBox1.Height);
+  Core.AZoomAll.Execute;
 end;
 
@@ -81 +103 @@
     Project.Bitmap.BackgroundColor.FromTColor(clBlack);
     Project.Bitmap.DPI := FormNew.SpinEditDPI.Value;
-    FormMain.Redraw;
+    AZoomAll.Execute;;
   end;
+end;
+
+procedure TCore.AZoomAllExecute(Sender: TObject);
+var
+  Factor: TFloatPoint;
+begin
+  with Core.Project, View do begin
+    Factor := FloatPoint((DestRect.Right - DestRect.Left) / Bitmap.Size.X,
+      (DestRect.Bottom - DestRect.Top) / Bitmap.Size.Y);
+    if Factor.X < Factor.Y then Zoom := Factor.X
+      else Zoom := Factor.Y;
+    Center(Rect(0, 0, Bitmap.Size.X, Bitmap.Size.Y));
+  end;
+  FormMain.Redraw;
 end;
 
 procedure TCore.AZoomInExecute(Sender: TObject);
 begin
-  Project.ViewPort.Zoom := Project.ViewPort.Zoom * 1.3;
+  Project.View.Zoom := Project.View.Zoom * ZoomFactor;
   FormMain.Redraw;
 end;
@@ -93 +129 @@
 procedure TCore.AZoomNormalExecute(Sender: TObject);
 begin
-  Project.ViewPort.Zoom := 1;
+  Project.View.Zoom := 1;
   FormMain.Redraw;
 end;
@@ -99 +135 @@
 procedure TCore.AZoomOutExecute(Sender: TObject);
 begin
-  Project.ViewPort.Zoom := Project.ViewPort.Zoom / 1.3;
+  Project.View.Zoom := Project.View.Zoom / ZoomFactor;
   FormMain.Redraw;
 end;
@@ -124 +160 @@
 end;
 
+procedure TCore.AImageGradientExecute(Sender: TObject);
+begin
+  Core.Project.Bitmap.Gradient;
+  FormMain.Redraw;
+end;
+
 procedure TCore.AImageMirrorExecute(Sender: TObject);
 begin