こんな感じかな?(まとめ?)


KHE00221  2008-01-29 01:40:22  No: 29542

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.


> KHE00221  2008-01-29 03:23:22  No: 29543

ご活躍ですね!!。

「再就職活動中」との事でしたが、成就致しましたか?。

どうでも良いことですが身内の者としては、其方の方が心配ですヨ。

フフフ...。


あああ  2008-01-30 00:50:07  No: 29544

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;
を入れてやってみたりしたんですが画像は出てこないんです。


Fusa  2008-01-30 01:24:20  No: 29545

動かしているわけではありませんが、
Button1Clickの中で
ShowImagesを呼び出しています。

ShowImagesの中で
PanelsとImagesを生成しているので
    Panel1: TPanel;
    Image1: TImage;
は必要ないはずです。

サンプルプログラム集 コンポーネントを実行時に作成する方法
http://homepage2.nifty.com/Mr_XRAY/Delphi/plSamples/160_CreateComponent.htm#101
ここみて勉強してください。


KHE00221  2008-01-30 01:27:13  No: 29546

選択したフォルダに BMP はあるのかな? JPEG とか PNG は表示しないぞ

とありますが、この中に

    Panel1: TPanel;
    Image1: TImage;

は必要ないですか?

動的に作成しているので必要ありません

Panels : array of TPanel;
Images : array of TImage;

と指定してあるでしょ


あああ  2008-01-30 02:17:15  No: 29547

Fusaさん
分かりました。
ありがとうございます!

KHE00221さん
ありがとうございます!
出来ました!
ずっとJPEGを読み込もうとしてたので表示しなかったみたいです!


※返信する前に利用規約をご確認ください。

※Google reCAPTCHA認証からCloudflare Turnstile認証へ変更しました。






  このエントリーをはてなブックマークに追加