两张位图叠加后,如何存储成新的位图? ( 积分: 102 )

  • 主题发起人 主题发起人 ppv
  • 开始时间 开始时间
P

ppv

Unregistered / Unconfirmed
GUEST, unregistred user!
要求是这样的:
Image1通过loadfromfile调出一幅位图作为背景,image2也是调出一个位图,位于image1之上,可以随意拖动,但不能移出image1的范围。Image1和Image2的大小都可以缩小拉伸。调整和时候把这两幅图合并输出成bmp文件。
尚未解决的问题:
1)image1,image2如何直接用鼠标进行缩小拉伸,尤其是image2,因为image2还需要随意拖动。
2)image2如何才能做到在拖动拉长的时候不移出image1.
3)如何把这合并幅图输出成bmp文件 (这点最重要,希望最先得到解决)
请高手帮帮忙,我是新手,请给出源代码,谢谢。
只有这么多分了,全部拿出来。
 
要求是这样的:
Image1通过loadfromfile调出一幅位图作为背景,image2也是调出一个位图,位于image1之上,可以随意拖动,但不能移出image1的范围。Image1和Image2的大小都可以缩小拉伸。调整和时候把这两幅图合并输出成bmp文件。
尚未解决的问题:
1)image1,image2如何直接用鼠标进行缩小拉伸,尤其是image2,因为image2还需要随意拖动。
2)image2如何才能做到在拖动拉长的时候不移出image1.
3)如何把这合并幅图输出成bmp文件 (这点最重要,希望最先得到解决)
请高手帮帮忙,我是新手,请给出源代码,谢谢。
只有这么多分了,全部拿出来。
 
对于第三个问题 你可以使用bltbit这个API函数
 
本想帮忙
我试了试,BitBlt表现和CopyRect一致,对于已拉伸的图像,拷贝后会复原尺寸
不会玩了
 
Avalon,能不能写出部分的源代码?
 
对了,下层容器用什么?PANEL吗?
 
第三个问题有解了
你最好把两面张图放在一个PaintBox上面(不是里面,PaintBox不是容器)
之后COPY这个PaintBox的Canvas属性到一个新的(可以隐藏的)TBitmap.Canvas

var
bitmap: TBitmap;
begin
bitmap := TBitmap.Create;
bitmap.Height := PaintBox1.Height;
bitmap.Width := PaintBox1.Width;
bitmap.Canvas.CopyRect(PaintBox1.ClientRect, PaintBox1.Canvas, PaintBox1.ClientRect);
bitmap.SaveToFile('mypic.bmp');
bitmap.Free;
end;
 
2,3都好弄。
1里的image2拖动也好弄。

就是直接用鼠标进行缩小拉伸不好弄。
是不是要做到这种效果,如:用鼠标点一下,
然后图片周围出现八个点,随便拖动哪个点,
图片大小都要随之改变》》?
 
前两个问题我还够呛
拖动你是怎么做的?判断鼠标吧?
 
拖动好做。
在鼠标的三个事件里写代码就行。

关键是拉伸不好搞,很麻烦。呵呵。。
 
还是朋友,对,就是那种效果。点击不在点上就可以移动。
someset,判断鼠标,[:(],好麻烦,只能移动,但移动出界没办法控制,还有不能改变大小。
 
这里是拖动的源代码

----------------------
var
CanMove:Boolean;
BMPCanMove:Boolean;
Old_X,Old_Y:Integer;

procedure TForm1.Image2MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if (Button = mbLeft) then
begin
CanMove := True;
Old_X := X;
Old_Y := Y;
end;
end;

procedure TForm1.Image2MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
CanMove:=False;
end;

procedure TForm1.Image2MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if (CanMove) then
begin
Image2.Left:=Image2.Left+(X - Old_X);
Image2.Top:=Image2.Top+(Y - Old_Y);
end;
end;
 
你倒不如用两个form,form2的parent设成form1,把form2的caption去掉点击任一点可移动,放个image还可以拉申.会省不少事.
 
那保存BMP时可麻烦了
两张图还是得放一个容器里
 
自己建个画布不就行了.
 
在你的Image2MouseMove中(CanMove分支内)加上

if Image2.BoundsRect.Right > Image1.BoundsRect.Right then
Image2.Left := Image1.Left + Image1.Width - Image2.Left;
if Image2.BoundsRect.Bottom > Image1.BoundsRect.Bottom then
Image2.Top := Image1.Top + Image1.Top - Image2.Height;
if Image2.Top < Image1.Top then
Image2.Top := Image1.Top;
if Image2.Left > Image1.Left then
Image2.Left := Image1.Left;

右下上左边界判断
鼠标拉伸不会搞了
 
担伸与保存已经解决。
至于托动,你参考上面兄弟的代码,我就不写了。
a.拉伸,点击Image1,Image左上角出现一黑点,
用鼠标拖动,即可拉伸。右键击Image1,取消拉伸。
(我只做一个点,其它你自己去加)。
b.保存。点“合成”按钮,即可保存。
源码如下:

unit Unit1;

interface

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

type
TForm1 = class(TForm)
ScrollBox1: TScrollBox;
Image2: TImage;
Image1: TImage;
Shape1: TShape;
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Shape1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
ShapeMouseDown: Boolean;
OldPoint, ShapePoint: TPoint;
ImageWidth, ImageHeight: integer;
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
ScrollBox1.DoubleBuffered := true;
Image1.Picture.LoadFromFile('D:/66.bmp');
Image2.Picture.LoadFromFile('D:/77.bmp');
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button=mbLeft then
begin
ImageWidth := Image1.Width;
ImageHeight := Image1.Height;
Shape1.Left := Image1.Left - (Shape1.Width div 2);
Shape1.Top := Image1.Top - (Shape1.Height div 2);
Shape1.Visible := true;
end else
begin
Shape1.Visible := false;
end;
end;

procedure TForm1.Shape1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button=mbLeft then
begin
ShapeMouseDown := true;
GetCursorPos(OldPoint);
ShapePoint.X := Shape1.Left;
ShapePoint.Y := Shape1.Top;
end;
end;

procedure TForm1.Shape1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
NewPoint: TPoint;
lLeft, lTop: integer;
begin
if ShapeMouseDown then
begin
GetCursorPos(NewPoint);
lLeft := ShapePoint.X + NewPoint.X - OldPoint.X;
lTop := ShapePoint.Y + NewPoint.Y - OldPoint.Y;
Shape1.Left := lLeft;
Shape1.Top := lTop;
Image1.Left := lLeft + (Shape1.Width div 2);
Image1.Top := lTop + (Shape1.Height div 2);
Image1.Width := ImageWidth - (NewPoint.X - OldPoint.X);
Image1.Height := ImageHeight - (NewPoint.Y - OldPoint.Y);
end;
end;

procedure TForm1.Shape1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if ShapeMouseDown then
begin
ShapeMouseDown := false;
ImageWidth := Image1.Width;
ImageHeight := Image1.Height;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
Bmp, Bmp2: TBitmap;
lx, ly: integer;
begin
Bmp := TBitmap.Create;
Bmp.PixelFormat := pf24Bit;
Bmp.Width := Image1.Width;
Bmp.Height := Image1.Height;
Bmp.Canvas.StretchDraw(Bmp.Canvas.ClipRect, Image1.Picture.Bitmap);

Bmp2 := TBitmap.Create;
Bmp2.PixelFormat := pf24Bit;
Bmp2.Width := Image2.Width;
Bmp2.Height := Image2.Height;
Bmp2.Canvas.StretchDraw(Bmp2.Canvas.ClipRect, Image2.Picture.Bitmap);

lx := Image2.Left-Image1.Left;
ly := Image2.Top-Image1.Top;
Bmp.Canvas.CopyRect(Rect(lx, ly, lx+Image2.Width, ly+Image2.Height),
Bmp2.Canvas,Bmp2.Canvas.ClipRect);
Bmp.SaveToFile(ExtractFilePath(Application.ExeName) + 'Test.Bmp');
Bmp2.Free;
Bmp.Free;
end;

end.
 
窗体文件的代码:
object Form1: TForm1
Left = 192
Top = 107
Width = 696
Height = 480
Caption = 'Form1'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object ScrollBox1: TScrollBox
Left = 0
Top = 0
Width = 688
Height = 453
Align = alClient
TabOrder = 0
object Image1: TImage
Left = 16
Top = 16
Width = 569
Height = 401
Stretch = True
OnMouseDown = Image1MouseDown
end
object Image2: TImage
Left = 360
Top = 112
Width = 145
Height = 121
Stretch = True
end
object Shape1: TShape
Left = 10
Top = 6
Width = 10
Height = 10
Brush.Color = clBlack
Pen.Width = 0
Visible = False
OnMouseDown = Shape1MouseDown
OnMouseMove = Shape1MouseMove
OnMouseUp = Shape1MouseUp
end
object Button1: TButton
Left = 616
Top = 352
Width = 57
Height = 73
Caption = '合成'
TabOrder = 0
OnClick = Button1Click
end
end
end
 
谢谢。就先这么搞吧。[:D]
 
后退
顶部