Googleマップのようにタイル状の画像を表示＆スクロールするには？ (ID：43560)

名前

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

本文

>１．複数の画像を表示させる方法
空の画像を用意し、必要に応じて画像を指定位置に書き込みます。

>２．表示させた複数の画像をスクロールさせる方法
スクロールボックスにするなら、スクロール時にイベントを発生させるようにします。

>３．次の画像が必要と判断させて、次を表示させる方法
表示範囲(rc1)の画像が書き込み済みかチェック(cells[ix, iy])します。

試してみましたが、全体の画像サイズが大きすぎると、システムリソース不足になる可能性があります。
その場合は、Image1のサイズを限定して、表示範囲を中心として追従するような工夫が必要になるかも。

uses
  Windows, Messages, Classes, Graphics,
  Controls, Forms, ExtCtrls, jpeg, Math;

type
  TScrollBox = class(Forms.TScrollBox)
  protected
    procedure WMHScroll(var Msg: TWMHScroll); message WM_HSCROLL;
    procedure WMVScroll(var Msg: TWMVScroll); message WM_VSCROLL;
  private
    FOnScroll: TNotifyEvent;
  public
    property OnScroll: TNotifyEvent read FOnScroll write FOnScroll;
  end;
  TForm1 = class(TForm)
    ScrollBox1: TScrollBox;
    Image1: TImage;
    procedure FormCreate(Sender: TObject);
    procedure FormResize(Sender: TObject);
  private
    { Private 宣言 }
    const
      // 単一画像サイズ（幅／高さ）
      cw = 1024;
      ch = 768;
      // タイル画像の数（縦／横）
      wcount = 10;
      hcount = 10;
      // この画像サイズで100x100にするとシステムリソース不足になるので...
    var
      // タイル画像のロード済みフラグ
      cells: array[0..wcount-1] of array[0..hcount-1] of Boolean;
    procedure ScrollBox1Scroll(Sender: TObject);
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TScrollBox.WMHScroll(var Msg: TWMHScroll);
begin
  inherited;
  if Assigned(FOnScroll) then FOnScroll(Self);
end;

procedure TScrollBox.WMVScroll(var Msg: TWMVScroll);
begin
  inherited;
  if Assigned(FOnScroll) then FOnScroll(Self);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  ScrollBox1.OnScroll := ScrollBox1Scroll;
  with Image1 do begin
    Left := 0;
    Top := 0;
    Width := cw*wcount;
    Height := ch*hcount;
  end;
  Image1.Picture.Bitmap.SetSize(Image1.Width, Image1.Height);
  ZeroMemory(@cells, SizeOf(cells));
  // 必要に応じて設定
  ScrollBox1.HorzScrollBar.Tracking := True;
  ScrollBox1.VertScrollBar.Tracking := True;
  // 初期位置の設定
  ScrollBox1.VertScrollBar.Position := 0;     // コンポーネント生成時は空撃ちが必要みたい...
  ScrollBox1.VertScrollBar.Position := Image1.Height div 2;
  ScrollBox1.HorzScrollBar.Position := Image1.Width div 2;
  ScrollBox1Scroll(nil)
end;

procedure TForm1.FormResize(Sender: TObject);
begin
  ScrollBox1Scroll(nil)
end;

procedure TForm1.ScrollBox1Scroll(Sender: TObject);
var
  x, y, ix, iy, ix0, iy0, ix1, iy1: Integer;
  jpg: TJPEGImage;
  rc0, rc1, rc2: TRect;
begin
  x := ScrollBox1.HorzScrollBar.ScrollPos;
  y := ScrollBox1.VertScrollBar.ScrollPos;
  // 見えている範囲
  rc1 := Rect(x, y, x+ScrollBox1.Width, y+ScrollBox1.Width);
  // 範囲の要素の先頭のインデックス
  ix0 := x div cw;
  iy0 := y div ch;
  // 範囲の要素の末尾のインデックス
  ix1 := Ceil((x+ScrollBox1.Width)/cw);
  iy1 := Ceil((y+ScrollBox1.Height)/ch);
  if ix1>=wcount then ix1 := wcount-1;
  if iy1>=hcount then iy1 := hcount-1;
  // 範囲内で空のタイルを描画
  for ix := ix0 to ix1 do begin
    rc2.Left := ix*cw;
    rc2.Right := rc2.Left+cw;
    for iy := iy0 to iy1 do begin
      rc2.Top := iy*ch;
      rc2.Bottom := rc2.Top+ch;
      if IntersectRect(rc0, rc1, rc2) and not cells[ix, iy] then begin
        jpg := TJPEGImage.Create;
        // この位置に表示したい画像ファイルを指定
        jpg.LoadFromFile('Penguins.jpg');
        Image1.Picture.Bitmap.Canvas.Draw(cw*ix, ch*iy, jpg);
        jpg.Free;
        cells[ix, iy] := True;
      end;
    end;
  end;
end;

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

戻る