【问题标题】:How to create a pan from composite image in Delphi如何在 Delphi 中从合成图像创建平移
【发布时间】:2023-04-09 21:33:01
【问题描述】:

我是 delphi 图形方法的新手,我一直在创建一个 ... viewport ,这就是我在为一个项目做它时的调用方式。很抱歉,我无法为它提供任何代码,但我被困在逻辑部分,搜索谷歌给我指出了一些 OnPaint、Draw 方法。但这些不是我想要完成的,因为我有,例如:

  1. 1600x1000 背景图片锚定在客户的顶部/底部/右侧和左侧。
  2. 多个 TImage 元素放置在设置的 x/y 坐标处。
  3. 类似于 HTML 中的地图元素的“热点”,我可以在其中设置可点击区域(对于我在步骤 2 中放置的图像)
  4. 无需缩放。
  5. 最重要的是,在拖动背景时,放置在背景顶部的那些 TImage 也需要拖动。

我的逻辑(在 HTML/jQuery 中)是创建一个#viewportBinder(这是我拖动的 div,透明 bg),然后是另一个名为 #viewtown(1600x1000,背景)的 div,其中包含 div(那些 TImages) 放置在 CSS 中的设定坐标处。

所以当我拖动 viewportBinder 时,jQuery 会在 #viewport 上设置新的 x/y。隐式地,#viewport 中的 div (TImages) 正在移动,因为父对象是相对定位的。

有人对这类项目有任何经验吗?任何sn-p代码?

更具体地说,我会给你我的 html 示例,说明我完成了什么以及我想将什么移植到 Delphi 代码中:http://www.youtube.com/watch?v=9iYqzvZFnGA

对不起,如果我不够清楚,我没有起点,因为我在 delphi 中根本没有这方面的经验。 (使用 RAD Studio 2010)

【问题讨论】:

  • 你的问题只是根据地形拖动建筑物吗?
  • “地形”不可调整大小,它只有 1600x1000,所以我需要在客户端(可能小于 1600x1000)隐式地使其可拖动,对客户端的最大约束为 1600x1000,我需要它可以在客户端表单周围拖动的地形(背景)。无需调整大小。

标签: image delphi delphi-2010 pan


【解决方案1】:

一个非常简短的示例,如何以简单的方式实现它。

您将使用一个 Paintbox 进行绘画、1 个背景图像、一组包含信息和透明 png 图像的记录。

画布可以在偏移/缩放/旋转中进行操作。 移动和命中检测将发生在 mousedown 和 mousemove 中。

它不完整,但可能会让您知道如何完成它。

[delphi]
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls,PNGImage, StdCtrls;

type
  TBuilding=Record   // record for building informations
    Pos:TPoint;
    PNGImage:TPngImage;
    // what ever needed
  End;

  TBuildingArray=Array of TBuilding; // array of buildings

  TForm1 = class(TForm)
    PaintBox1: TPaintBox;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure PaintBox1Paint(Sender: TObject);
    procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Button1Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private-Deklarationen }
    FXoffs,FYOffs,FZoom:Double; // offset and zoom for painting
    FMouseDownPoint:TPoint;
    FBackGroundPNG:TPNGImage;
    FBuildingArray:TBuildingArray;
    procedure Check4Hit(X, Y: Integer);
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation
uses Math;
{$R *.dfm}


Procedure SetCanvasZoomAndRotation(ACanvas:TCanvas;Zoom:Double;Angle:Double;CenterpointX,CenterpointY:Double);
var
    form : tagXFORM;
    Winkel:Double;
begin
      Winkel := DegToRad(Angle);
      SetGraphicsMode(ACanvas.Handle, GM_ADVANCED);
      SetMapMode(ACanvas.Handle,MM_ANISOTROPIC);
      form.eM11 := Zoom * cos( Winkel);
      form.eM12 := Zoom *Sin( Winkel)  ;
      form.eM21 := Zoom * (-sin( Winkel));
      form.eM22 := Zoom * cos( Winkel) ;
      form.eDx := CenterpointX;
      form.eDy := CenterpointY;
      SetWorldTransform(ACanvas.Handle,form);
end;

Procedure ResetCanvas(ACanvas:TCanvas);
begin
   SetCanvasZoomAndRotation(ACanvas , 1, 0, 0,0);
end;


procedure TForm1.FormCreate(Sender: TObject);
var
 Path:String;
 i:Integer;
begin
   FZoom := 1;
   DoubleBuffered := true;
   Path := ExtractFilePath(Paramstr(0));
   FBackGroundPNG:=TPNGImage.Create;
   FBackGroundPNG.LoadFromFile(Path + 'infect.png');
   SetLength(FBuildingArray,3);
   for I := 0 to High(FBuildingArray)  do
      begin
         FBuildingArray[i].PNGImage := TPngImage.Create;
         FBuildingArray[i].PNGImage.LoadFromFile(Path + Format('B%d.png',[i]));
         FBuildingArray[i].Pos.X := I * 300;
         FBuildingArray[i].Pos.Y := Random(1000);
      end;

end;
procedure TForm1.FormDestroy(Sender: TObject);
var
 i:Integer;
begin
   for I := 0 to High(FBuildingArray)  do
      begin
         FBuildingArray[i].PNGImage.Free;
      end;
   FBackGroundPNG.Free;
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
  if FZoom=0.5 then FZoom := 1 else FZoom := 0.5;
  PaintBox1.Invalidate;
end;

procedure TForm1.Check4Hit(X,Y:Integer);
var
 i,Index:Integer;
 R:TRect;
 P:TPoint;
begin
   index := -1;
   for I := 0 to High(FBuildingArray)  do
      begin
         R := Rect(FBuildingArray[i].Pos.X,FBuildingArray[i].Pos.Y
                    ,FBuildingArray[i].Pos.X + FBuildingArray[i].PNGImage.Width
                    ,FBuildingArray[i].Pos.Y + FBuildingArray[i].PNGImage.Height);
         P := Point(Round((x - FXOffs)/FZoom) ,Round((y - FYOffs)/FZoom));
         if PtInRect(R,P) then Index := i;
      end;
   if index > -1 then
      begin
        Caption := Format('Last hit %d',[index]);
      end
   else Caption := 'No Hit';
end;

procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
   Check4Hit(X,Y);
   FMouseDownPoint.X := X;
   FMouseDownPoint.Y := Y;
end;

procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
   if ssLeft in Shift then
      begin
         FXoffs := -( FMouseDownPoint.X - X) ;
         FYoffs := -( FMouseDownPoint.Y - Y) ;
         if FXoffs>0 then FXoffs := 0;
         if FYoffs>0 then FYoffs := 0;
         PaintBox1.Invalidate;
      end;
end;

procedure TForm1.PaintBox1Paint(Sender: TObject);
var
 i:Integer;
begin
   SetCanvasZoomAndRotation(PaintBox1.Canvas,FZoom,0,FXoffs,FYOffs);
   PaintBox1.Canvas.Draw(0,0,FBackGroundPNG);
   for I := 0 to High(FBuildingArray)  do
      begin
         PaintBox1.Canvas.Draw(FBuildingArray[i].Pos.X,FBuildingArray[i].Pos.Y,FBuildingArray[i].PNGImage);
      end;
end;

end.

[/delphi]

【讨论】:

  • 我会试一试,看看我能做什么。请继续关注问题。现在谢谢,一旦我看到这个想法变成现实(可能在一个小时左右),我会立即接受答案
  • 值得一提的是,如果有人在拖动时将背景(偏移)重置为 0,0,请按照以下说明操作:声明一个 tPoint : TPoint;在 {public} 部分下,然后在 MouseDown 事件中设置 tPoint.x := Trunc(FXoffs);和 tPoint.y := Trunc(FYoffs);因为我们需要从 doulbe 中取出 int。然后在 MouseMove 事件中,为它们各自的公式添加 tempx 和 tempy。例如:FXoffs := -( FMouseDownPoint.X - X) + tempx;和 FYoffs := -( FMouseDownPoint.Y - Y) + tempy;这样程序就知道他上次在哪里停止了拖动对象。问候。
【解决方案2】:

抱歉,过去几年我使用 Lazarus 而不是 Delphi。但这篇文章将提供信息:http://wiki.lazarus.freepascal.org/Developing_with_Graphics#Create_a_custom_control_which_draws_itself 关于相对坐标没什么好说的——很简单。 关于拖动:很久以前,在一个遥远的星系中……那是这样的:

// To start dragging
procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
// To stop dragging
procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP;
// To perform dragging
procedure WMMouseMove(var Message: TWMMouseMove); message WM_MOUSEMOVE;

【讨论】:

  • 是的,TPaintBox 已经将这些作为事件称为 OnMouseDown / OnMouseMove,但我会考虑 bummi 的答案,因为它不是低级编程。我的意思是,当 Embarcadero 已经在标准库中实现了“最佳”方法来完成类似的事情时,为什么还要做所有艰苦的工作。不过感谢您的宝贵时间。
猜你喜欢
  • 1970-01-01
  • 1970-01-01
  • 2021-07-12
  • 1970-01-01
  • 2011-09-21
  • 1970-01-01
  • 1970-01-01
  • 2019-05-22
  • 2012-02-05
相关资源
最近更新 更多