Changeset 10 for trunk/UProject.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/UProject.pas (modified) (4 diffs)

trunk/UProject.pas

@@ -10 +10 @@
 type
 
-  { TViewPort }
+  { TView }
 
-  TViewPort = class
+  TView = class
+  private
+    FSrcRect: TRect;
+    FDestRect: TRect;
+    FZoom: Double;
+    procedure SetDestRect(AValue: TRect);
+    procedure SetSrcRect(AValue: TRect);
+    procedure SetZoom(AValue: Double);
   public
-    Pos: TPoint;
-    Zoom: Double;
-    ViewSize: TPoint;
+    procedure Center(Rect: TRect);
+    constructor Create;
+    function DestToSrcPos(Pos: TPoint): TPoint;
+    function SrcToDestPos(Pos: TPoint): TPoint;
+    property DestRect: TRect read FDestRect write SetDestRect;
+    property Zoom: Double read FZoom write SetZoom;
+    property SrcRect: TRect read FSrcRect write SetSrcRect;
   end;
 
@@ -24 +35 @@
     FileName: string;
     Bitmap: TGBitmap;
-    ViewPort: TViewPort;
+    View: TView;
     constructor Create;
     destructor Destroy; override;
@@ -30 +41 @@
 
 implementation
+
+function RectEquals(A, B: TRect): Boolean;
+begin
+  Result := (A.Left = B.Left) and (A.Top = B.Top) and
+    (A.Right = B.Right) and (A.Bottom = B.Bottom);
+end;
+
+
+{ TView }
+
+procedure TView.SetDestRect(AValue: TRect);
+var
+  Diff: TPoint;
+begin
+  if RectEquals(FDestRect, AValue) then Exit;
+  Diff := Point(Trunc((FDestRect.Right - FDestRect.Left) / FZoom -
+    (AValue.Right - AValue.Left) / FZoom) div 2,
+    Trunc((FDestRect.Bottom - FDestRect.Top) / FZoom -
+    (AValue.Bottom - AValue.Top) / FZoom) div 2);
+  FDestRect := AValue;
+  SrcRect := Bounds(FSrcRect.Left + Diff.X, FSrcRect.Top + Diff.Y,
+    Trunc((FDestRect.Right - FDestRect.Left) / FZoom),
+    Trunc((FDestRect.Bottom - FDestRect.Top) / FZoom));
+end;
+
+procedure TView.SetSrcRect(AValue: TRect);
+begin
+  if RectEquals(FSrcRect, AValue) then Exit;
+  FSrcRect := AValue;
+end;
+
+procedure TView.SetZoom(AValue: Double);
+const
+  ZoomMin = 1/10000;
+  ZoomMax = 10000;
+begin
+  if FZoom = AValue then Exit;
+  if (FZoom > ZoomMax) or (FZoom < ZoomMin) then Exit;
+  FZoom := AValue;
+  FSrcRect := Bounds(Trunc(FSrcRect.Left + (FSrcRect.Right - FSrcRect.Left) div 2 -
+    (DestRect.Right - DestRect.Left) / FZoom / 2),
+    Trunc(FSrcRect.Top + (FSrcRect.Bottom - FSrcRect.Top) div 2 -
+    (DestRect.Bottom - DestRect.Top) / FZoom / 2),
+    Trunc((DestRect.Right - DestRect.Left) / FZoom),
+    Trunc((DestRect.Bottom - DestRect.Top) / FZoom));
+end;
+
+procedure TView.Center(Rect: TRect);
+begin
+  FSrcRect := Bounds(Rect.Left + (Rect.Right - Rect.Left) div 2 - (FSrcRect.Right - FSrcRect.Left) div 2,
+    Rect.Top + (Rect.Bottom - Rect.Top) div 2 - (FSrcRect.Bottom - FSrcRect.Top) div 2,
+    FSrcRect.Right - FSrcRect.Left,
+    FSrcRect.Bottom - FSrcRect.Top);
+end;
+
+constructor TView.Create;
+begin
+  FZoom := 1;
+end;
+
+function TView.DestToSrcPos(Pos: TPoint): TPoint;
+begin
+  Result := Point(Trunc(Pos.X / FZoom + FSrcRect.Left),
+    Trunc(Pos.Y / FZoom + FSrcRect.Top));
+end;
+
+function TView.SrcToDestPos(Pos: TPoint): TPoint;
+begin
+  Result := Point(Trunc((Pos.X - FSrcRect.Left) * FZoom),
+    Trunc((Pos.Y - FSrcRect.Top) * FZoom));
+end;
 
 
@@ -37 +119 @@
 begin
   Bitmap := TGBitmap.Create;
-  ViewPort := TViewPort.Create;
+  View := TView.Create;
 end;
 
 destructor TProject.Destroy;
 begin
-  ViewPort.Free;
+  View.Free;
   Bitmap.Free;
   inherited Destroy;