Changeset 10 for trunk/Forms/UFormMain.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/Forms/UFormMain.pas (modified) (5 diffs)

trunk/Forms/UFormMain.pas

@@ -7 +7 @@
 uses
   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Menus,
-  ExtCtrls, ComCtrls;
+  ExtCtrls, ComCtrls, types;
 
 type
@@ -23 +23 @@
     MenuItem17: TMenuItem;
     MenuItem18: TMenuItem;
+    MenuItem19: TMenuItem;
     MenuItemRecentFiles: TMenuItem;
     MenuItem15: TMenuItem;
@@ -37 +38 @@
     StatusBar1: TStatusBar;
     Timer1: TTimer;
+    procedure FormActivate(Sender: TObject);
+    procedure FormCreate(Sender: TObject);
+    procedure FormDestroy(Sender: TObject);
+    procedure FormShow(Sender: TObject);
+    procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
+      Shift: TShiftState; X, Y: Integer);
+    procedure PaintBox1MouseLeave(Sender: TObject);
+    procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
+      Y: Integer);
+    procedure PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
+      Shift: TShiftState; X, Y: Integer);
+    procedure PaintBox1MouseWheelDown(Sender: TObject; Shift: TShiftState;
+      MousePos: TPoint; var Handled: Boolean);
+    procedure PaintBox1MouseWheelUp(Sender: TObject; Shift: TShiftState;
+      MousePos: TPoint; var Handled: Boolean);
     procedure PaintBox1Paint(Sender: TObject);
     procedure PaintBox1Resize(Sender: TObject);
     procedure Timer1Timer(Sender: TObject);
   private
-    { private declarations }
+    TempBitmap: TBitmap;
+    StartMousePoint: TPoint;
+    StartViewPoint: TPoint;
+    MoveActive: Boolean;
+    MousePos: TPoint;
+    Activated: Boolean;
   public
+    procedure UpdateStatusBar;
     procedure Redraw;
   end;
@@ -60 +82 @@
 procedure TFormMain.PaintBox1Resize(Sender: TObject);
 begin
-
+  Redraw;
 end;
 
 procedure TFormMain.Timer1Timer(Sender: TObject);
-var
-  Bitmap: TBitmap;
 begin
   Timer1.Enabled := False;
-  try
-    Bitmap := TBitmap.Create;
-    Bitmap.SetSize(Core.Project.Bitmap.Size.X, Core.Project.Bitmap.Size.Y);
-    Bitmap.BeginUpdate(True);
-    Core.Project.Bitmap.PaintToCanvas(Bitmap.Canvas);
-    Bitmap.EndUpdate(False);
-    PaintBox1.Canvas.Draw(0, 0, Bitmap);
-  finally
-    Bitmap.Free;
+  PaintBox1.Repaint;
+  UpdateStatusBar;
+end;
+
+procedure TFormMain.UpdateStatusBar;
+var
+  Pos: TPoint;
+begin
+  with Core.Project do begin
+    Pos := View.DestToSrcPos(MousePos);
+    StatusBar1.Panels[0].Text := '[' + IntToStr(Pos.X) + ', ' + IntToStr(Pos.Y) + '] Zoom:' +
+      FloatToStr(Core.Project.View.Zoom);
   end;
 end;
@@ -87 +110 @@
 procedure TFormMain.PaintBox1Paint(Sender: TObject);
 begin
-  Redraw;
+  with Core.Project do begin
+    TempBitmap.SetSize(View.SrcRect.Right - View.SrcRect.Left,
+      View.SrcRect.Bottom - View.SrcRect.Top);
+    TempBitmap.BeginUpdate(True);
+    TempBitmap.Canvas.Brush.Color := clBlack;
+    TempBitmap.Canvas.FillRect(0, 0, TempBitmap.Width, TempBitmap.Height);
+    View.DestRect := Bounds(0, 0, PaintBox1.Width, PaintBox1.Height);
+    Bitmap.PaintToCanvas(TempBitmap.Canvas, View.SrcRect);
+    TempBitmap.EndUpdate(False);
+    PaintBox1.Canvas.StretchDraw(View.DestRect, TempBitmap);
+    //PaintBox1.Canvas.Draw(0, 0, TempBitmap);
+  end;
+end;
+
+procedure TFormMain.FormCreate(Sender: TObject);
+begin
+  TempBitmap := TBitmap.Create;
+end;
+
+procedure TFormMain.FormActivate(Sender: TObject);
+begin
+  if not Activated then begin
+    Activated := True;
+    Core.Init;
+  end;
+end;
+
+procedure TFormMain.FormDestroy(Sender: TObject);
+begin
+  TempBitmap.Free;
+end;
+
+procedure TFormMain.FormShow(Sender: TObject);
+begin
+end;
+
+procedure TFormMain.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
+  Shift: TShiftState; X, Y: Integer);
+begin
+  if Button = mbLeft then begin
+    StartMousePoint := Point(X, Y);
+    StartViewPoint := Core.Project.View.SrcRect.TopLeft;
+    MoveActive := True;
+  end;
+end;
+
+procedure TFormMain.PaintBox1MouseLeave(Sender: TObject);
+begin
+  MoveActive := False;
+end;
+
+procedure TFormMain.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
+  Y: Integer);
+begin
+  MousePos := Point(X, Y);
+  if Assigned(Core.Project) then begin
+    if MoveActive then
+    with Core.Project do begin
+      View.SrcRect := Bounds(Trunc(StartViewPoint.X + (StartMousePoint.X - X) / View.Zoom),
+        Trunc(StartViewPoint.Y + (StartMousePoint.Y - Y) / View.Zoom),
+        View.SrcRect.Right - View.SrcRect.Left,
+        View.SrcRect.Bottom - View.SrcRect.Top);
+      Redraw;
+    end;
+  end;
+  UpdateStatusBar;
+end;
+
+procedure TFormMain.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
+  Shift: TShiftState; X, Y: Integer);
+begin
+  MoveActive := False;
+end;
+
+procedure TFormMain.PaintBox1MouseWheelDown(Sender: TObject;
+  Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
+begin
+  Core.AZoomOut.Execute;
+end;
+
+procedure TFormMain.PaintBox1MouseWheelUp(Sender: TObject; Shift: TShiftState;
+  MousePos: TPoint; var Handled: Boolean);
+begin
+  Core.AZoomIn.Execute;
 end;