我要用D6.0 编一个类似Acdsee 的软件,请高手帮帮我 ( 积分: 50 )

  • 主题发起人 主题发起人 小手冰凉
  • 开始时间 开始时间

小手冰凉

Unregistered / Unconfirmed
GUEST, unregistred user!
我想知道如何实现点击一个button 用鼠标就可以实现拖拽图片的功能,其次当平移图片到边界的时候就无法在拖拽了,而不漏出白边如何实现,请各位老师指点[?]
 
我想知道如何实现点击一个button 用鼠标就可以实现拖拽图片的功能,其次当平移图片到边界的时候就无法在拖拽了,而不漏出白边如何实现,请各位老师指点[?]
 
unit HjDateTimePicker;

interface
//{$I HjConst.inc}

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, stdctrls, comctrls, YearEdit, MonthEdit, DayEdit, HjUtilitys;

type
THjDateTimePicker = class(TPanel)
private
{ Private declarations }
FAOwner: TComponent;
FChineseName : string;
FColorHighlight: TColor;
FColorShadow: TColor;
FTransparent: boolean;
YearEdit: TYearEdit;
MonthEdit: TMonthEdit;
DayEdit: TDayEdit;
YearLabel: TLabel;
MonthLabel: TLabel;
DayLabel: TLabel;
DateButton: TDateTimePicker;
//Splitter1: TSplitter;
procedure SetYearEditWidth(const Value: integer);
function GetYearEditWidth: integer;
procedure SetYearEditHeight(const Value: integer);
function GetYearEditHeight: integer;
procedure SetYearEditLeft(const Value: integer);
function GetYearEditLeft: integer;
procedure SetYearEditTop(const Value: integer);
function GetYearEditTop: integer;
procedure SetMonthEditWidth(const Value: integer);
function GetMonthEditWidth: integer;
procedure SetMonthEditHeight(const Value: integer);
function GetMonthEditHeight: integer;
procedure SetMonthEditLeft(const Value: integer);
function GetMonthEditLeft: integer;
procedure SetMonthEditTop(const Value: integer);
function GetMonthEditTop: integer;
procedure SetDayEditWidth(const Value: integer);
function GetDayEditWidth: integer;
procedure SetDayEditHeight(const Value: integer);
function GetDayEditHeight: integer;
procedure SetDayEditLeft(const Value: integer);
function GetDayEditLeft: integer;
procedure SetDayEditTop(const Value: integer);
function GetDayEditTop: integer;
procedure SetTransparent(const Value: boolean);
procedure SetChineseName(const Value: string);

protected
{ Protected declarations }
procedure Paint; override;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
//procedure Invalidate; override;
//procedure CreateWnd; override;
//procedure CreateParams(var Params: TCreateParams); override;
published
{ Published declarations }
property YearEditWidth: integer read GetYearEditWidth write SetYearEditWidth;
property YearEditHeight: integer read GetYearEditHeight write SetYearEditHeight;
property YearEditLeft: integer read GetYearEditLeft write SetYearEditLeft;
property YearEditTop: integer read GetYearEditTop write SetYearEditTop;
property MonthEditWidth: integer read GetMonthEditWidth write SetMonthEditWidth;
property MonthEditHeight: integer read GetMonthEditHeight write SetMonthEditHeight;
property MonthEditLeft: integer read GetMonthEditLeft write SetMonthEditLeft;
property MonthEditTop: integer read GetMonthEditTop write SetMonthEditTop;
property DayEditWidth: integer read GetDayEditWidth write SetDayEditWidth;
property DayEditHeight: integer read GetDayEditHeight write SetDayEditHeight;
property DayEditLeft: integer read GetDayEditLeft write SetDayEditLeft;
property DayEditTop: integer read GetDayEditTop write SetDayEditTop;
property Transparent: Boolean read FTransparent write SetTransparent default False;
property ChineseName : string read FChineseName write SetChineseName;
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('Hjsoft', [THjDateTimePicker]);
end;

{ THjDateTimePicker }

constructor THjDateTimePicker.Create(AOwner: TComponent);
var
i, tempComponentCount: integer;
begin
inherited Create(AOwner);
FAOwner := AOwner;
Self.Caption := ' ';
Self.BevelInner := bvNone;
Self.BevelOuter := bvNone;
Self.Width := 217;
Self.Height := 33;
//Self.ParentColor := True;
//Self.ControlStyle := Self.ControlStyle - [csOpaque];
if (csDesigning in Self.ComponentState) then
begin
tempComponentCount := 0;
for i := 0 to FAOwner.ComponentCount - 1 do
begin
if FAOwner.Components is THjDateTimePicker then
tempComponentCount := tempComponentCount + 1;
end;
Self.ChineseName := '日期类型' + inttostr(tempComponentCount);
end;

YearEdit := TYearEdit.Create(FAOwner);
if (csDesigning in Self.ComponentState) then
begin
tempComponentCount := 0;
for i := 0 to FAOwner.ComponentCount - 1 do
begin
if FAOwner.Components is TYearEdit then
tempComponentCount := tempComponentCount + 1;
end;
YearEdit.Name := 'YearEdit' + inttostr(tempComponentCount);
YearEdit.Text := '';
end;
YearEdit.Parent := Self;
YearEdit.Top := 6;
YearEdit.Left := 6;
YearEdit.Width := 38;
YearEdit.Height := 21;

{if csDesigning in ComponentState then
MonthEdit.Create(FAOwner)
else }
MonthEdit := TMonthEdit.Create(FAOwner);
if (csDesigning in Self.ComponentState) then
begin
tempComponentCount := 0;
for i := 0 to FAOwner.ComponentCount - 1 do
begin
if FAOwner.Components is TMonthEdit then
tempComponentCount := tempComponentCount + 1;
end;
MonthEdit.Name := 'MonthEdit'+inttostr(tempComponentCount);
MonthEdit.Text := '';
end;
MonthEdit.Parent := Self;
MonthEdit.Top := 6;
MonthEdit.Left := 65;
MonthEdit.Width := 38;
MonthEdit.Height := 21;

DayEdit := TDayEdit.Create(FAOwner);
if (csDesigning in Self.ComponentState) then
begin
tempComponentCount := 0;
for i := 0 to FAOwner.ComponentCount - 1 do
begin
if FAOwner.Components is TDayEdit then
tempComponentCount := tempComponentCount + 1;
end;
DayEdit.Name := 'DayEdit'+inttostr(tempComponentCount);
DayEdit.Text := '';
end;
DayEdit.Parent := Self;
DayEdit.Top := 6;
DayEdit.Left := 126;
DayEdit.Width := 38;
DayEdit.Height := 21;

YearLabel := TLabel.Create(FAOwner);
if (csDesigning in Self.ComponentState) then
begin
tempComponentCount := 0;
for i := 0 to FAOwner.ComponentCount - 1 do
begin
if FAOwner.Components is TLabel then
tempComponentCount := tempComponentCount + 1;
end;
YearLabel.Name := 'YearLable'+inttostr(tempComponentCount);
end;
//YearLabel.Create(FAOwner);
YearLabel.Parent := Self;
YearLabel.Top := 10;
YearLabel.Left := 48;
YearLabel.Width := 12;
YearLabel.Caption := '年';
YearLabel.Transparent := True;

MonthLabel := TLabel.Create(FAOwner);
if (csDesigning in Self.ComponentState) then
begin
tempComponentCount := 0;
for i := 0 to FAOwner.ComponentCount - 1 do
begin
if FAOwner.Components is TLabel then
tempComponentCount := tempComponentCount + 1;
end;
MonthLabel.Name := 'MonthLabel'+inttostr(tempComponentCount);
end;
//MonthLabel.Create(FAOwner);
MonthLabel.Parent := Self;
MonthLabel.Top := 10;
MonthLabel.Left := 106;
MonthLabel.Width := 12;
MonthLabel.Caption := '月';
MonthLabel.Transparent := True;

DayLabel := TLabel.Create(FAOwner);
if (csDesigning in Self.ComponentState) then
begin
tempComponentCount := 0;
for i := 0 to FAOwner.ComponentCount - 1 do
begin
if FAOwner.Components is TLabel then
tempComponentCount := tempComponentCount + 1;
end;
DayLabel.Name := 'DayLabel'+inttostr(tempComponentCount);
end;
//DayLabel.Create(FAOwner);
DayLabel.Parent := Self;
DayLabel.Top := 10;
DayLabel.Left := 168;
DayLabel.Width := 12;
DayLabel.Caption := '日';
DayLabel.Transparent := True;

DateButton := TDateTimePicker.Create(Self);
if (csDesigning in Self.ComponentState) then
begin
tempComponentCount := 0;
for i := 0 to FAOwner.ComponentCount - 1 do
begin
if FAOwner.Components is TDateTimePicker then
tempComponentCount := tempComponentCount + 1;
end;
DateButton.Name := 'DateButton'+inttostr(tempComponentCount);
end;
DateButton.Parent := Self;
DateButton.Height := 23;
DateButton.Top := 5;
DateButton.Left := 183;
DateButton.Width := 18;

//IsDestroy := False;

end;
 
谢谢老人家
我还有一些不明白:程序中年月日用来做什么
 
To 小手冰凉,
为了显示显示
 
再请教老人家:
用鼠标实现拖拽图片的功能代码
是从哪里开始到哪里结束的啊,
小弟我太笨,没看懂,万分感谢
 
用鼠标实现拖拽图片
我不明白您的意思?
 
把你的示例代码贴出来,估计你说的问题比较难的,老人家可能是问题回复错了

另外有个软件叫ImageSee,类似Acdsee的,在http://www.playicq.cn 可以下载,找不到就留下你的email,我发给你,看有参考价值没有
 
谢谢 chenybin
我的email:wang_hlj@msn.com
可能我没有说明白,真是很抱歉,我再说一下:类似photoshop里面的hand tool 工具,就是在左边工具条里面的那个小手按钮,当你单击一下它的时候,把鼠标放在图片上时就可以变成小手的形状,并且可以实现平移图片的的功能。
我想知道用delphi 该如何实现呢? 谢谢大家的帮助,非常感谢各位。
 
现将我写的程序附上,请各位老师指正:
(这个小程序实现了,图片的放大,缩小和平移,我已经实现了用Tbutton 来实现,想请教如何用鼠标控制图片的自由平移[单击鼠标左键不放,平移图片,左键放开平移结束的功能]等于photoshop 中的 hand tool 工具)
unit Unit1;

interface

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

type
TForm1 = class(TForm)
Edit1: TEdit;
Button1: TButton;
Image1: TImage;
Edit2: TEdit;
Button2: TButton;
Button3: TButton;
Button4: TButton;
Button5: TButton;
Button6: TButton;
Label1: TLabel;
Label2: TLabel;
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormCreate(Sender: TObject);
procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
a,x1,x2,y1,y2:integer;

implementation

{$R *.dfm}

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
edit1.Text:=inttostr(x);
edit2.Text:=inttostr(y);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
x1:=0;
y1:=0;
x2:=image1.Width;
y2:=image1.Height;
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
edit1.Text:=inttostr(x);
edit2.Text:=inttostr(y);
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);

var

bitmap: Tbitmap;
myrect,myother:trect;
begin
if a=1 then
begin
x1:=x1+5;
y1:=y1+5;
x2:=x2-5;
y2:=y2-5;
Myother:= Rect(0,0,image1.Width,image1.Height);
myrect := rect(x1,y1,x2,y2);
bitmap := Tbitmap.Create;
bitmap.LoadFromFile('D:/新建文件夹/新建文件夹/未命名2.bmp');
image1.canvas.fillrect(myother);
image1.Canvas.CopyRect(Myother,Bitmap.Canvas,Myrect);
end;


if a=0 then
begin
x1:=x1-5;
y1:=y1-5;
x2:=x2+5;
y2:=y2+5;

Myother:= Rect(0,0,image1.Width,image1.Height);
myrect := rect(x1,y1,x2,y2);
bitmap := Tbitmap.Create;
bitmap.LoadFromFile('D:/新建文件夹/新建文件夹/未命名2.bmp');
image1.canvas.fillrect(myother);
image1.Canvas.CopyRect(Myother,Bitmap.Canvas,Myrect);
end;

if a=3 then
begin
x1:=x1;
y1:=y1-10;
x2:=x2;
y2:=y2-10;
if y2<image1.Height then
begin
a:=4;
end;
Myother:= Rect(0,0,image1.Width,image1.Height);
myrect:=rect(x1,y1,x2,y2);
bitmap := Tbitmap.Create;
bitmap.LoadFromFile('D:/新建文件夹/新建文件夹/未命名2.bmp');
image1.canvas.fillrect(myother);
image1.Canvas.CopyRect(Myother,Bitmap.Canvas,Myrect);
end;
if a=4 then
begin
x1:=x1;
y1:=y1+10;
x2:=x2;
y2:=y2+10;
if y2<image1.Height then
begin
a:=3;
end;
Myother:= Rect(0,0,image1.Width,image1.Height);
myrect:=rect(x1,y1,x2,y2);
bitmap := Tbitmap.Create;
bitmap.LoadFromFile('D:/新建文件夹/新建文件夹/未命名2.bmp');
image1.canvas.fillrect(myother);
image1.Canvas.CopyRect(Myother,Bitmap.Canvas,Myrect);
end;
if a=5 then
begin
x1:=x1+10;
y1:=y1;
x2:=x2+10;
y2:=y2;
if (x2-630)>image1.width then
begin
a:=6;
end
else


Myother:= Rect(0,0,image1.Width,image1.Height);
myrect:=rect(x1,y1,x2,y2);
bitmap := Tbitmap.Create;
bitmap.LoadFromFile('D:/新建文件夹/新建文件夹/未命名2.bmp');
image1.canvas.fillrect(myother);
image1.Canvas.CopyRect(Myother,Bitmap.Canvas,Myrect);
end;

if a=6 then
begin
x1:=x1-10;
y1:=y1;
x2:=x2-10;
y2:=y2;
if x1=0 then
begin
a:=5;
end;
Myother:= Rect(0,0,image1.Width,image1.Height);
myrect:=rect(x1,y1,x2,y2);
bitmap := Tbitmap.Create;
bitmap.LoadFromFile('D:/新建文件夹/新建文件夹/未命名2.bmp');
image1.canvas.fillrect(myother);
image1.Canvas.CopyRect(Myother,Bitmap.Canvas,Myrect);
end;
end;




procedure TForm1.Button2Click(Sender: TObject);

begin
a:=1;
end;

procedure TForm1.Button3Click(Sender: TObject);

begin
a:=0;
end;

procedure TForm1.Button6Click(Sender: TObject);
begin
a:=3;
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
a:=4;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
a:=5;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
a:=6;
end;

end.
 
小手冰凉:
我有代码。是个控件
 
邮件已发,大概明白楼主的意思了,不过觉得楼主大可不必如此

把Image放到一个容器里面,比如说Panel或者是ScrollBox里面,设置属性,比如AutoSize,但是不能设置Align属性,然后设置2个全局变量,一个是bMove表示是否可移动,一个是StartPoint,记录按下的位置,大概思路如下
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
Edit1.Text := inttostr(X);
Edit2.Text := inttostr(Y);
if bMove then begin
//Image1.Left := Image1.Left + 当前X和刚刚记录的起始X的差值,Top相同

end;
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
bMove := True;
// 设置可以拖动,一个全局变量,并记录当前位置,作为判断用
end;

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

另外,邮件已发
 
如果想实现 ACdsee 的功能, 用 TImage, 实在是实现不可能的,你给出Email, 我将代码给你,还包括Demo 一个。
 
多人接受答案了。
 
后退
顶部