view/trunk/Unit1.pas

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ExtCtrls, ComCtrls, FileCtrl, ExtDlgs, Jpeg, Math,
  System.Types, System.UITypes;

type
  TRGB = record
    R: Byte;
    G: Byte;
    B: Byte;
  end;

  TRGBArray = array [Word] of TRGB;

  PRGBArray = ^TRGBArray;
  
  TForm1 = class(TForm)
    ListBox1: TListBox;
    Button1: TButton;
    Button2: TButton;
    Panel1: TPanel;
    SpeedButton4: TSpeedButton;
    SpeedButton5: TSpeedButton;
    SpeedButton6: TSpeedButton;
    SpeedButton7: TSpeedButton;
    SpeedButton8: TSpeedButton;
    SpeedButton9: TSpeedButton;
    Image1: TImage;
    Edit3: TEdit;
    UpDown1: TUpDown;
    DirectoryListBox1: TDirectoryListBox;
    Label1: TLabel;
    Button3: TButton;
    OpenPictureDialog1: TOpenPictureDialog;
    Label2: TLabel;
    CheckBox1: TCheckBox;
    Button4: TButton;
    Label3: TLabel;
    Button5: TButton;
    Bevel1: TBevel;
    Label4: TLabel;
    Edit1: TEdit;
    SpeedButton1: TSpeedButton;
    UpDown2: TUpDown;
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    Label5: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
    procedure ListBox1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormPaint(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure SpeedButton9Click(Sender: TObject);
    procedure SpeedButton8Click(Sender: TObject);
    procedure SpeedButton5Click(Sender: TObject);
    procedure SpeedButton4Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure RadioButton1Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure RadioButton2Click(Sender: TObject);
  private
    { Private ���� }
    MyRect: TRect;
    MySize: integer;
    MouseDown: Boolean;
    DownedPos: TPoint;
    Gt: TPoint;
    function CalMyRect: TRect;
    procedure TrimImage;
  public
    { Public ���� }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  if (Sender = Button1)and(ListBox1.ItemIndex > -1) then
  begin
    if (CheckBox1.Checked = true)and(FileExists(DirectoryListBox1.GetItemPath(DirectoryListBox1.ItemIndex)
                +'\_'+ExtractFileName(ListBox1.Items[ListBox1.ItemIndex])) = true) then
    begin
      if MessageDlg('Assign file ?',mtConfirmation,[mbYes,mbCancel],0) = mrOK then
      begin
                TrimImage;
      end;
    end else
    begin
        TrimImage;
    end;
  end;
  if ListBox1.ItemIndex < ListBox1.Count-1 then
  begin
        ListBox1.ItemIndex:=ListBox1.ItemIndex+1;
  end;
        ListBox1Click(Sender);
end;

procedure TForm1.ListBox1Click(Sender: TObject);
var
  img: TPicture;
begin
  if ListBox1.ItemIndex > -1 then
  begin
        img:=TPicture.Create;
    try
        Caption:=ListBox1.Items[ListBox1.ItemIndex];
        img.LoadFromFile(Caption);
        Image1.Picture.Bitmap.Assign(img.Graphic);
    finally
        img.Free;
    end;
        FormPaint(Sender);
  end;
end;

procedure TForm1.ListBox1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
        ListBox1Click(Sender);
end;

procedure TForm1.FormPaint(Sender: TObject);
var
  i, j: integer;
begin
  if Image1.Picture.Width = 0 then
  begin
        Exit;
  end;
  if MyRect.Right-MyRect.Left > 500 then
  begin
    if MyRect.Right-MyRect.Left > Image1.Picture.Width+200 then
    begin
        MySize:=Image1.Picture.Width div 127;
        MyRect:=CalMyRect;
        Label2.Caption:=IntToStr(MySize);
    end;
    if (MyRect.Right-MyRect.Left+500 > Image1.Picture.Width)or
      (MyRect.Bottom-MyRect.Top+500 > Image1.Picture.Height) then
    begin
        Canvas.FillRect(Rect(0,0,2*350,2*350));
    end;
        i:=MyRect.Left;
        j:=MyRect.Top;
        Canvas.CopyRect(Rect(0,0,350,350),Image1.Canvas,Rect(i-250,j-250,i+100,j+100));
        i:=MyRect.Right;
        Canvas.CopyRect(Rect(350,0,2*350,350),Image1.Canvas,
                Rect(i-100,j-250,i+250,j+100));
        i:=MyRect.Left;
        j:=MyRect.Bottom;
        Canvas.CopyRect(Rect(0,350,350,2*350),Image1.Canvas,
                Rect(i-250,j-100,i+100,j+250));
        i:=MyRect.Right;
        Canvas.CopyRect(Rect(350,350,2*350,2*350),Image1.Canvas,
                Rect(i-100,j-100,i+250,j+250));
        Canvas.DrawFocusRect(Rect(250,250,450,450));
  end else
  begin
        i:=(Image1.Picture.Width-2*350) div 2;
        j:=(Image1.Picture.Height-2*350) div 2;
        Canvas.CopyRect(Rect(0,0,2*350,2*350),Image1.Canvas,
                Rect(i,j,i+2*350,j+2*350));
        i:=(2*350-MyRect.Right+MyRect.Left) div 2;
        j:=(2*350-MyRect.Bottom+MyRect.Top) div 2;
        Canvas.DrawFocusRect(Rect(i,j,2*350-i,2*350-j));
  end;
end;

function TForm1.CalMyRect: TRect;
var
  i, j, m, n: integer;
const
  a = 127;
  b = 89;
begin

{
  case ComboBox1.ItemIndex of
  0:
  begin
        i:=127;
        j:=89;
  end;
  1:
  begin
        i:=254;
        j:=178;
  end;
  else
        i:=381;
        j:=267;
  end;
  }
        i:=MySize*a;
        j:=MySize*b;
        m:=(Image1.Picture.Width-i) div 2;
        n:=(Image1.Picture.Height-j) div 2;
        result:=Rect(m,n,m+i,n+j);

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
        MySize:=20;
        Label2.Caption:=IntToStr(MySize);
        Canvas.Pen.Color:=clBlue;
        Canvas.Pen.Width:=10;
        Canvas.Pen.Mode:=pmNotXor;
end;

procedure TForm1.SpeedButton9Click(Sender: TObject);
begin
  if Image1.Picture.Width > MyRect.Right-MyRect.Left then
  begin
        inc(MySize);
        Label2.Caption:=IntToStr(MySize);
        MyRect:=CalMyRect;
        FormPaint(Sender);
  end;
end;

procedure TForm1.SpeedButton8Click(Sender: TObject);
begin
  if MySize > 1 then
  begin
        dec(MySize);
        Label2.Caption:=IntToStr(MySize);
        MyRect:=CalMyRect;
        FormPaint(Sender);
  end;
end;

procedure TForm1.TrimImage;
var
  img: TImage;
begin
        img:=TImage.Create(Self);
  try
        img.Width:=MyRect.Right-MyRect.Left+1;
        img.Height:=MyRect.Bottom-MyRect.Top+1;
        img.Canvas.CopyRect(img.ClientRect,Image1.Canvas,MyRect);
        img.Picture.SaveToFile(DirectoryListBox1.GetItemPath(DirectoryListBox1.ItemIndex)
                +'\_'+ExtractFileName(ListBox1.Items[ListBox1.ItemIndex]));
  finally
        img.Free;
  end;
end;

procedure TForm1.SpeedButton5Click(Sender: TObject);
var
  i: integer;
begin
  if Sender = SpeedButton5 then
  begin
        i:=UpDown1.Position;
  end else
  begin
        i:=-UpDown1.Position;
  end;
  with MyRect do
  begin
        Left:=Left+i;
        Right:=Right+i;
  end;
        FormPaint(Sender);
end;

procedure TForm1.SpeedButton4Click(Sender: TObject);
var
  i: integer;
begin
  if Sender = SpeedButton4 then
  begin
        i:=UpDown1.Position;
  end else
  begin
        i:=-UpDown1.Position;
  end;
  with MyRect do
  begin
        Top:=Top-i;
        Bottom:=Bottom-i;
  end;
        FormPaint(Sender);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  if Image1.Picture.Width = 0 then
  begin
        Exit;
  end;
        MySize:=20;
        MyRect:=CalMyRect;
  if MyRect.Right-MyRect.Left > Image1.Picture.Width+200 then
  begin
        MySize:=Image1.Picture.Width div 127;
    if MySize = 0 then
    begin
        MySize:=1;
    end;
        MyRect:=CalMyRect;
        Label2.Caption:=IntToStr(MySize);
  end;
        FormPaint(Sender);
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  case Button of
  mbLeft:
  begin
        MouseDown:=true;
        DownedPos:=Point(X,Y);
        Gt:=Point(X,Y);
        Edit1.Text:='0';
        FormPaint(Sender);
  end;
  mbRight:
        Button1Click(Button1);
  end;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  i, j: integer;
begin
  if RadioButton1.Checked = true then
  begin
    if MouseDown = true then
    begin
        i:=X-DownedPos.X;
        j:=Y-DownedPos.Y;
    with MyRect do
    begin
        Left:=Left-i;
        Right:=Right-i;
        Top:=Top-j;
        Bottom:=Bottom-j;
    end;
        DownedPos:=Point(X,Y);
        FormPaint(Sender);
    end;
  end else
  begin
    if MouseDown = true then
    begin
        Canvas.MoveTo(DownedPos.X,DownedPos.Y);
        Canvas.LineTo(Gt.X,Gt.Y);
        Canvas.MoveTo(DownedPos.X,DownedPos.Y);
        Canvas.LineTo(X,Y);
        GT:=Point(X,Y);
    end;
  end;
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then
  begin
        MouseDown:=false;
    if RadioButton2.Checked = true then
    begin
      if Gt.X-DownedPos.X = 0 then
      begin
                UpDown2.Position:=90;
      end else
      begin
                UpDown2.Position:=Round(RadToDeg(ArcTan(
                        -(Gt.Y-DownedPos.Y)/(Gt.X-DownedPos.X))));
      end;
    end;
  end;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
        Close;
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
  if OpenPictureDialog1.Execute and(OpenPictureDialog1.Files.Count > 0) then
  begin
        ListBox1.Items.Assign(OpenPictureDialog1.Files);
        ListBox1.ItemIndex:=0;
        Label3.Caption:=ExtractFileDir(ListBox1.Items[0]);
        Label3.Hint:=Label3.Caption;
        ListBox1Click(Sender);
        MyRect:=CalMyRect;
        FormPaint(Sender);
  end;
end;

procedure TForm1.RadioButton1Click(Sender: TObject);
begin
        MouseDown:=false;
        FormPaint(Sender);
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
var
  i, j, a, b: integer;
  m, n: integer;
  p: Extended;
  bmp: TBitmap;
  s, t: PRGBArray;
begin
        i:=UpDown2.Position;
  if i <> 0 then
  begin
    if FileExists(Caption) = true then
    begin
        bmp:=TBitmap.Create;
      try
                bmp.PixelFormat:=pf24Bit;
                bmp.Assign(Image1.Picture.Graphic);
                Image1.Picture.Bitmap.Assign(bmp);
                a:=bmp.Width div 2;
                b:=bmp.Height div 2;
                p:=DegToRad(-i);
        for i:=0 to bmp.Height-1 do
        begin
                s:=bmp.ScanLine[i];
          for j:=0 to bmp.Width-1 do
          begin
                m:=Round((j-a)*Cos(p)-(i-b)*Sin(p))+a;
                n:=Round((j-a)*Sin(p)+(i-b)*Cos(p))+b;
            if (m >= 0)and(n >= 0)and(m < bmp.Width)and(n < bmp.Height) then
            begin
                t:=Image1.Picture.Bitmap.ScanLine[n];
                s[j]:=t[m];
            end;
          end;
                Application.ProcessMessages;
                Label5.Caption:=IntToStr(100*i div bmp.Height);
          if SpeedButton1.Down = false then
          begin
                Exit;
          end;
        end;
                Image1.Picture.Bitmap.Assign(bmp);
                FormPaint(Sender);
      finally
                bmp.Free;
      end;
    end;
  end;
        SpeedButton1.Down:=false;
end;

procedure TForm1.RadioButton2Click(Sender: TObject);
var
  s: TPicture;
begin
  if FileExists(Caption) = true then
  begin
        s:=TPicture.Create;
    try
        s.LoadFromFile(Caption);
        Image1.Picture.Bitmap.Assign(s.Graphic);
    finally
        s.Free;
    end;
        FormPaint(Sender);
  end;
end;

end.