こんな感じかな？(まとめ？) (ID:29542)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

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.

←解決時は質問者本人がここをチェックしてください。

戻る