Buttonクリックで BMP を取得してフォームに表示 (TPanel の上に TImage)
Panel は移動・リサイズ可能
フォームサイズを変更すると横スクロールが出ないように整列
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
OpenDialog1: TOpenDialog;
Button1: TButton;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormResize(Sender: TObject);
private
public
procedure ShowImages(FilesList:TStringList;W,H,Line:Integer);
procedure ImageMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
end;
var
Form1: TForm1;
Button1,Button2 : TButton;
Panels : array of TPanel;
Images : array of TImage;
FilesList : TStringList;
implementation
{$R *.dfm}
procedure AlignmentComponent(Sender:TScrollingWinControl);
var
I,X,Y : Integer;
Sender2 : TComponent;
begin
if Sender.Owner is TApplication then Sender2 := Sender else Sender2 := Sender.Owner;
X := 20-Sender.HorzScrollBar.Position;
Y := 20-Sender.VertScrollBar.Position;
for I:=0 to Sender2.ComponentCount -1 do
begin
if Sender2.Components[I] is TPanel then
begin
if TControl(Sender2.Components[I]).Parent = Sender then
begin
TControl(Sender2.Components[I]).Left := X;
TControl(Sender2.Components[I]).Top := Y;
X := X + TControl(Form1.Components[I]).Width + 20;
if Sender.Width < X + TControl(Sender2.Components[I]).Width + 20 then
begin
X := 20-Sender.HorzScrollBar.Position;
Y := Y + TControl(Sender2.Components[I]).Height + 20;
end;
end;
end;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FilesList := TStringList.Create;
Position := poDesktopCenter;
DoubleBuffered := True;
end;
procedure TForm1.FormResize(Sender: TObject);
begin
//横スクロールバーが出ないように整列
AlignmentComponent(Form1);
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
I : Integer;
begin
for I:=0 to High(Images) do
begin
Images[I].Free;
end;
for I:=0 to High(Panels) do
begin
Panels[I].Free;
end;
SetLength(Images,0);
SetLength(Panels,0);
FilesList.Free;
end;
//BMP取得
procedure TForm1.Button1Click(Sender: TObject);
var
SearchRec : TSearchRec;
I : Integer;
Path : String;
begin
if OpenDialog1.Execute = True then
begin
Path := ExtractFilePath(OpenDialog1.FileName);
I := FindFirst(Path + '*.BMP',faAnyFile,SearchRec);
while I = 0 do
begin
FilesList.Add (Path + SearchRec.Name);
I := FindNext(SearchRec);
end;
FindClose(SearchRec);
end;
ShowImages(FilesList,160,120,5); // 160x120で横に5個並べる
end;
procedure TForm1.ImageMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
Panel : TPanel;
begin
if Sender is TImage then Panel := TPanel(TImage(Sender).Parent);
if Sender is TPanel then Panel := TPanel(Sender);
Panel.BringToFront;
ReleaseCapture;
if X < Panel.BevelWidth then
begin
if Y < Panel.BevelWidth then
Panel.Perform(WM_SYSCOMMAND, SC_SIZE or 4, 0) //左上
else if Y > Panel.Height - Panel.BevelWidth then
Panel.Perform(WM_SYSCOMMAND, SC_SIZE or 7, 0) //左下
else
Panel.Perform(WM_SYSCOMMAND, SC_SIZE or 1, 0); //左
end else if X > Panel.Width - Panel.BevelWidth then
begin
if Y < Panel.BevelWidth then
Panel.Perform(WM_SYSCOMMAND, SC_SIZE or 5, 0) //右上
else if Y > Panel.Height - Panel.BevelWidth then
Panel.Perform(WM_SYSCOMMAND, SC_SIZE or 8, 0) //右下
else
Panel.Perform(WM_SYSCOMMAND, SC_SIZE or 2, 0); //右
end else if Y < Panel.BevelWidth then
Panel.Perform(WM_SYSCOMMAND, SC_SIZE or 3, 0) //上
else if Y > Panel.Height - Panel.BevelWidth then
Panel.Perform(WM_SYSCOMMAND, SC_SIZE or 6, 0) //下
else
Panel.Perform(WM_SYSCOMMAND, SC_MOVE or 2, 0); //移動
Exit;
end;
//W , H は Panel のサイズ
//Line は Panel を横に何個並べるか
procedure TForm1.ShowImages(FilesList:TStringList;W,H,Line:Integer);
var
I,X,Y : Integer;
begin
for I:=0 to High(Images) do
begin
Images[I].Free;
end;
for I:=0 to High(Panels) do
begin
Panels[I].Free;
end;
SetLength(Images,FilesList.Count);
SetLength(Panels,FilesList.Count);
AutoScroll := False;
for I:=0 to FilesList.Count -1 do
begin
Panels[I] := TPanel.Create(Self);
Panels[I].Parent := Self;
Panels[I].Left := (I mod Line) * W;
Panels[I].Top := (I div Line) * H;
Panels[I].Width := W;
Panels[I].Height := H;
Panels[I].BevelWidth := 3;
Panels[I].OnMouseDown := ImageMouseDown;
Images[I] := TImage.Create(Panels[I]);
Images[I].Parent := Panels[I];
Images[I].Left := 0;
Images[I].Top := 0;
Images[I].Align := alClient;
Images[I].Stretch := True;
Images[I].Proportional := True;
Images[I].Picture.LoadFromFile(FilesList[I]);
Images[I].OnMouseDown := ImageMouseDown;
end;
AutoScroll := True;
end;
end.
ご活躍ですね!!。
「再就職活動中」との事でしたが、成就致しましたか?。
どうでも良いことですが身内の者としては、其方の方が心配ですヨ。
フフフ...。
type
TForm1 = class(TForm)
OpenDialog1: TOpenDialog;
Button1: TButton;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormResize(Sender: TObject);
とありますが、この中に
Panel1: TPanel;
Image1: TImage;
は必要ないですか?
フォルダの選択画面になり、その中の画像を選択してもフォーム上に画像が出てこないんです。
Panel1: TPanel;
Image1: TImage;
を入れてやってみたりしたんですが画像は出てこないんです。
動かしているわけではありませんが、
Button1Clickの中で
ShowImagesを呼び出しています。
ShowImagesの中で
PanelsとImagesを生成しているので
Panel1: TPanel;
Image1: TImage;
は必要ないはずです。
サンプルプログラム集 コンポーネントを実行時に作成する方法
http://homepage2.nifty.com/Mr_XRAY/Delphi/plSamples/160_CreateComponent.htm#101
ここみて勉強してください。
選択したフォルダに BMP はあるのかな? JPEG とか PNG は表示しないぞ
とありますが、この中に
Panel1: TPanel;
Image1: TImage;
は必要ないですか?
動的に作成しているので必要ありません
Panels : array of TPanel;
Images : array of TImage;
と指定してあるでしょ
Fusaさん
分かりました。
ありがとうございます!
KHE00221さん
ありがとうございます!
出来ました!
ずっとJPEGを読み込もうとしてたので表示しなかったみたいです!
ツイート | ![]() |