Develop and Download Open Source Software

bitmaplisttool

Browse Subversion Repository

/[bitmaplisttool]/Unit1.pas

Diff of /Unit1.pas

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 2 by yamat0jp, Wed Jul 15 23:11:42 2015 UTC revision 3 by yamat0jp, Thu Jul 16 20:11:51 2015 UTC
# Line 20  type Line 20  type
20      Label2: TLabel;      Label2: TLabel;
21      Button3: TButton;      Button3: TButton;
22      SavePictureDialog1: TSavePictureDialog;      SavePictureDialog1: TSavePictureDialog;
23        CheckBox1: TCheckBox;
24      procedure Button1Click(Sender: TObject);      procedure Button1Click(Sender: TObject);
25      procedure FormCreate(Sender: TObject);      procedure FormCreate(Sender: TObject);
26      procedure FormDestroy(Sender: TObject);      procedure FormDestroy(Sender: TObject);
# Line 27  type Line 28  type
28      procedure Button3Click(Sender: TObject);      procedure Button3Click(Sender: TObject);
29      procedure UpDown1ChangingEx(Sender: TObject; var AllowChange: Boolean;      procedure UpDown1ChangingEx(Sender: TObject; var AllowChange: Boolean;
30        NewValue: Integer; Direction: TUpDownDirection);        NewValue: Integer; Direction: TUpDownDirection);
31        procedure CheckBox1Click(Sender: TObject);
32    private    private
33      procedure Execute(aCount: integer);      procedure Execute(aCount: Integer);
34      { Private 宣言 }      { Private 宣言 }
35    public    public
36      { Public 宣言 }      { Public 宣言 }
# Line 44  implementation Line 46  implementation
46    
47  procedure TForm1.Button1Click(Sender: TObject);  procedure TForm1.Button1Click(Sender: TObject);
48  var  var
49    s: TGraphic;    bmp1, bmp2: TBitmap;
50    p: TPicture;    r: TRect;
51    i: Integer;    i, j, k: Integer;
52      procedure LoadToBitmap(FileName: TFileName; var bmp: TBitmap);
53      var
54        s: TPngImage;
55        p: TPicture;
56      begin
57        if ExtractFileExt(FileName) = '.png' then
58        begin
59          s := TPngImage.Create;
60          s.LoadFromFile(FileName);
61          bmp.Width := s.Width;
62          bmp.Height := s.Height;
63          s.Draw(bmp.Canvas, Rect(0, 0, bmp.Width, bmp.Height));
64        end
65        else
66        begin
67          p := TPicture.Create;
68          p.LoadFromFile(FileName);
69          bmp.Assign(p.Graphic);
70        end;
71      end;
72    
73  begin  begin
74    if OpenPictureDialog1.Execute = true then    if OpenPictureDialog1.Execute = true then
75      for i := 0 to OpenPictureDialog1.Files.Count - 1 do      for i := 0 to OpenPictureDialog1.Files.Count - 1 do
76      begin      begin
77        if ExtractFileExt(OpenPictureDialog1.Files[i]) = '.png' then        bmp1 := TBitmap.Create;
78          s:=TPngImage.Create        bmp2 := TBitmap.Create;
79        else        try
80        begin          LoadToBitmap(OpenPictureDialog1.FileName, bmp2);
81          p:=TPicture.Create;          if CheckBox1.Checked = true then
82          p.LoadFromFile(OpenPictureDialog1.FileName);          begin
83          s:=p.Graphic;            if bmp2.Width < bmp2.Height then
84              begin
85                j := (bmp2.Height - bmp2.Width) div 2;
86                k := bmp2.Width;
87                r := Rect(0, j, bmp2.Width, bmp2.Height - j);
88              end
89              else
90              begin
91                j := (bmp2.Width - bmp2.Height) div 2;
92                k := bmp2.Height;
93                r := Rect(j, 0, bmp2.Width - j, bmp2.Height);
94              end;
95              bmp1.Width := k;
96              bmp1.Height := k;
97              bmp1.Canvas.CopyRect(Rect(0, 0, bmp1.Width, bmp1.Height),
98                bmp2.Canvas, r);
99            end
100            else
101              bmp1.Assign(bmp2);
102          finally
103            bmp2.Free;
104        end;        end;
105        s.LoadFromFile(OpenPictureDialog1.Files[i]);        List.Add(bmp1);
       List.Add(s);  
106        Label2.Caption := IntToStr(List.Count);        Label2.Caption := IntToStr(List.Count);
107        Execute(UpDown1.Position);        Execute(UpDown1.Position);
108      end;      end;
# Line 72  var Line 114  var
114    s: TBitmap;    s: TBitmap;
115  begin  begin
116    for i := 0 to List.Count - 1 do    for i := 0 to List.Count - 1 do
117      TPngImage(List[i]).Free;      TBitmap(List[i]).Free;
118    List.Clear;    List.Clear;
119    Label2.Caption := '0';    Label2.Caption := '0';
120    s:=Image1.Picture.Bitmap;    s := Image1.Picture.Bitmap;
121    s.Canvas.FillRect(Rect(0,0,s.Width,s.Height));    s.Canvas.FillRect(Rect(0, 0, s.Width, s.Height));
122  end;  end;
123    
124  procedure TForm1.Button3Click(Sender: TObject);  procedure TForm1.Button3Click(Sender: TObject);
# Line 85  begin Line 127  begin
127      Image1.Picture.Bitmap.SaveToFile(SavePictureDialog1.FileName);      Image1.Picture.Bitmap.SaveToFile(SavePictureDialog1.FileName);
128  end;  end;
129    
130    procedure TForm1.CheckBox1Click(Sender: TObject);
131    begin
132      if MessageDlg('再読み込みしますか', mtCustom, [mbYes, mbNo], 0) = mrYes then
133      begin
134        Button2Click(Sender);
135        Button1Click(Sender);
136      end;
137    end;
138    
139  procedure TForm1.FormCreate(Sender: TObject);  procedure TForm1.FormCreate(Sender: TObject);
140  begin  begin
141    List := TList.Create;    List := TList.Create;
# Line 99  end; Line 150  end;
150  procedure TForm1.UpDown1ChangingEx(Sender: TObject; var AllowChange: Boolean;  procedure TForm1.UpDown1ChangingEx(Sender: TObject; var AllowChange: Boolean;
151    NewValue: Integer; Direction: TUpDownDirection);    NewValue: Integer; Direction: TUpDownDirection);
152  var  var
153    n: integer;    n: Integer;
154  begin  begin
155    case Direction of    case Direction of
156      updUp:      updUp:
157        n:=UpDown1.Position+UpDown1.Increment;        n := UpDown1.Position + UpDown1.Increment;
158      updDown:      updDown:
159        n:=UpDown1.Position-UpDown1.Increment;        n := UpDown1.Position - UpDown1.Increment;
160      else    else
161        Exit;      Exit;
162    end;    end;
163    Execute(n);    Execute(n);
164  end;  end;
165    
166  procedure TForm1.Execute(aCount: integer);  procedure TForm1.Execute(aCount: Integer);
167  var  var
168    i: Integer;    i: Integer;
169    s: TGraphic;    s: TBitmap;
170    bmp: TBitmap;    bmp: TBitmap;
171    j: Integer;    j: Integer;
172    k, m: Integer;    k, m: Integer;
173  label label1;  label Label1;
   procedure Draw;  
   var  
     p: TPngImage;  
     t: TBitmap;  
   begin  
     if s is TPngImage then  
       (s as TPngImage).Draw(bmp.Canvas, Rect(i * s.Width, j * s.Height, (i + 1) * s.Width,  
         (j + 1) * s.Height))  
     else  
     begin  
       t:=TBitmap.Create;  
       t.Assign(s);  
       bmp.Canvas.Draw(i*s.Width,j*s.Height,t);  
     end;  
   end;  
174  begin  begin
175    if List.Count = 0 then    if List.Count = 0 then
176      Exit      Exit
177    else    else
178      s:=List[0];      s := List[0];
179    m := List.Count div aCount;    m := List.Count div aCount;
180    bmp := TBitmap.Create;    bmp := TBitmap.Create;
181    try    try
182      bmp.Width := s.Width * m;      bmp.Width := s.Width * m;
183      bmp.Height := s.Height * aCount;      bmp.Height := s.Height * aCount;
184      k := 0;      k := 0;
185      for j := 0 to aCount-1 do      for j := 0 to aCount - 1 do
186        for i := 0 to m - 1 do        for i := 0 to m - 1 do
187        begin        begin
188          if k <= List.Count - 1 then          if k <= List.Count - 1 then
# Line 155  begin Line 191  begin
191            inc(k);            inc(k);
192          end          end
193          else          else
194            goto label1;            goto Label1;
195          Draw;          bmp.Canvas.Draw(i * s.Width, j * s.Height, s);
196        end;        end;
197      label1:    Label1:
198      Image1.Picture.Bitmap.Assign(bmp);      Image1.Picture.Bitmap.Assign(bmp);
199    finally    finally
200      bmp.Free;      bmp.Free;
Legend:
Removed from v.2  
changed lines
  Added in v.3
Back to OSDN">Back to OSDN
 ViewVC Help
Powered by ViewVC 1.1.26  
About OSDN
Find Software
Develop Software
Help