请高手相助,或者能够提供类似功能的控件。
解决方案 »
- delphi调用C++dll,多个返回值处理
- bde可以用分页技术吗?
- 如何用ADO得方式进行异构数据库(ORACLE 和 SQL)之间的查询?
- 在TAdoDataSet中如何设置Filter比较两个字段值
- 循环执行这个语句时出错,为什么
- 在2k,xp下的进程隐藏问题(非dll注入)
- RAD Studio XE3 全球发布会(北京11月7日、上海11月9日 、深圳11月11日)
- 请问学完了基本的控件和编程以后,是不是该找一本数据库开发的的书比着例子做几个程序.我不知道在往哪方面发展了.请各位高手多多指教小弟.
- 请大家给点意见
- procedure of object ,procedure??????
- 急需能下栽能用的OFFICEXP激活文件
- 为什么我把窗口的属性设成置顶了,但是在使用过程中有时候会失效呢?
如果是突起或凹下的线,用TBevel, 将宽度设为1
unit Unit1;interfaceuses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, ImgList, ComCtrls;type
TDrawingTool = (dtLine, dtRectangle, dtEllipse, dtRoundRect);
TNode = Record
rectx1 : integer;
rectx2 : integer;
recty1 : integer;
recty2 : integer;
name : string;
pic : tpicture;
//rect : trect;
end; TLine =record
StartPt,EndPt :TPoint;
end; TForm1 = class(TForm)
ScrollBox1: TScrollBox;
Image1: TImage;
TreeView1: TTreeView;
ImageList1: TImageList;
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormCreate(Sender: TObject);
procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure TreeView1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
private
{ Private declarations }
pic : tpicture;
name : string;
drawing,moving,Lining : Boolean;
picnode : array of TNode;
ArrLine :array of TLine;
nodecount,nodeselectNo : integer;
LineCount,LineSelectNo :integer;
origin, movept :TPoint;
DrawingTool: TDrawingTool;
procedure DrawShape(TopLeft, BottomRight: TPoint; AMode: TPenMode);
procedure RefreshImage;
public
{ Public declarations }
end;var
Form1: TForm1;implementation{$R *.DFM}procedure TForm1.RefreshImage;
var i :integer;
beginend;procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
i : integer;
tmprect : trect;
begin
if button = mbleft then
begin
if drawing then
begin
image1.Canvas.Draw(x,y,pic.Graphic);
setlength(picNode,nodeCount+1);
picnode[nodecount].rectx1 := x;
picnode[nodecount].recty1 := y;
picnode[nodecount].rectx2 := x + pic.Width;
picnode[nodecount].recty2 := y + pic.Height;
picnode[nodecount].name := name;
picnode[nodecount].pic := tpicture.Create;
picnode[nodecount].pic := pic;
image1.Canvas.TextOut(picnode[nodecount].rectx1,picnode[nodecount].recty2,picnode[nodecount].name);
nodecount := nodecount + 1;
drawing := False;
end
else
begin
for i := 0 to nodecount do
begin
tmprect := rect(picnode[i].rectx1,picnode[i].recty1,picnode[i].rectx2,picnode[i].recty2);
if ptinrect(tmprect,point(x,y)) then
begin
moving := true;
nodeselectNo := i;
break;
end;
end;
end;
end else if Button =mbRight then
begin
for i := 0 to nodecount do
begin
tmprect := rect(picnode[i].rectx1,picnode[i].recty1,picnode[i].rectx2,picnode[i].recty2);
if ptinrect(tmprect,point(x,y)) then
begin
//moving := true;
nodeselectNo := i;
DrawingTool :=dtLine;
lining :=true;
Origin :=point(x,y);
MovePt := Origin;
break;
end;
end;
end;
end;procedure TForm1.FormCreate(Sender: TObject);
begin
nodecount := 0;
LineCount :=0;
setlength(picnode,30);
drawing := false;
moving := false;
Lining :=false;
end;procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
tmprect : trect;
i :integer;
CanLine :Boolean;
begin
CanLine :=False;
if button = mbleft then
begin
if moving then
begin
tmprect := rect(picnode[nodeselectno].rectx1,picnode[nodeselectno].recty1,picnode[nodeselectno].rectx2,picnode[nodeselectno].recty2);
image1.Canvas.FillRect(tmpRect);
image1.Canvas.Brush.Color := clWhite;
image1.Canvas.TextOut(picnode[nodeselectno].rectx1,picnode[nodeselectno].recty2,' ');
image1.Canvas.Draw(x,y,picnode[nodeselectno].pic.Graphic);
picnode[nodeselectno].rectx1 := x;
picnode[nodeselectno].recty1 := y;
picnode[nodeselectno].rectx2 := x + picnode[nodeselectno].pic.Width;
picnode[nodeselectno].recty2 := y + picnode[nodeselectno].pic.Height;
image1.Canvas.TextOut(picnode[nodeselectno].rectx1,picnode[nodeselectno].recty2,picnode[nodeselectno].name);
for i :=0 to Length(ArrLine)-1 do
begin
if ptInRect(tmpRect,ArrLine[i].StartPt) then
begin
DrawShape(Point(x,y),ArrLine[i].EndPt,PmCopy);
DrawShape(ArrLine[i].StartPt,ArrLine[i].EndPt,pmNotXor);
ArrLine[i].StartPt :=Point(x,y);
end else if ptInRect(tmpRect,ArrLine[i].EndPt) then
begin
DrawShape(ArrLine[i].StartPt,Point(x,y),PmCopy);
DrawShape(ArrLine[i].StartPt,ArrLine[i].EndPt,pmNotXor);
ArrLine[i].EndPt :=Point(x,y);
end;
end;
image1.Refresh;
moving := false;
end;
end else if button =mbRight then
begin
if lining then
begin
for i := 0 to nodecount do
begin
tmprect := rect(picnode[i].rectx1,picnode[i].recty1,picnode[i].rectx2,picnode[i].recty2);
if ptinrect(tmprect,point(x,y)) then
begin
CanLine :=True;
break;
end;
end;
if CanLine then
begin
DrawShape(Origin, Point(X, Y), pmCopy);
inc(LineCount);
setlength(ArrLine,LineCount);
ArrLine[LineCount-1].StartPt :=Origin;
ArrLine[LineCount-1].EndPt :=Point(x,y);
lining :=false;
end else
begin
DrawShape(Origin,Point(x,y),pmNotXor);
lining :=false;
end;
end;
end;
end;procedure TForm1.TreeView1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
i : integer;
bmp : tbitmap;
begin
for i := 0 to Treeview1.Items.Count - 1 do
begin
if Treeview1.Items[i].Selected then
begin
pic := TPicture.Create;
bmp :=TBitmap.Create;
ImageList1.GetBitmap(Treeview1.Items[i].ImageIndex,bmp);
//SelectIndex := i;
pic.Assign(bmp);
Drawing :=True;
name :=TreeView1.Items[i].Text;
bmp.Free;
end;
end;
end;procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
i : integer;
begin
pic.Free;
for i := 0 to nodecount-1 do
picnode[nodecount].pic.Free;
end;procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if lining then
begin
DrawShape(Origin, MovePt, pmNotXor);
MovePt := Point(X, Y);
DrawShape(Origin, MovePt, pmNotXor);
end;
end;procedure TForm1.DrawShape(TopLeft, BottomRight: TPoint; AMode: TPenMode);
begin
with Image1.Canvas do
begin
Pen.Mode := AMode;
case DrawingTool of
dtLine:
begin
Image1.Canvas.MoveTo(TopLeft.X, TopLeft.Y);
Image1.Canvas.LineTo(BottomRight.X, BottomRight.Y);
end;
dtRectangle: Image1.Canvas.Rectangle(TopLeft.X, TopLeft.Y, BottomRight.X,
BottomRight.Y);
dtEllipse: Image1.Canvas.Ellipse(Topleft.X, TopLeft.Y, BottomRight.X,
BottomRight.Y);
dtRoundRect: Image1.Canvas.RoundRect(TopLeft.X, TopLeft.Y, BottomRight.X,
BottomRight.Y, (TopLeft.X - BottomRight.X) div 2,
(TopLeft.Y - BottomRight.Y) div 2);
end;
end;
end;end.
unit Unit1;interfaceuses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, ImgList, ComCtrls;type
TDrawingTool = (dtLine, dtRectangle, dtEllipse, dtRoundRect);
TNode = Record
rectx1 : integer;
rectx2 : integer;
recty1 : integer;
recty2 : integer;
name : string;
pic : tpicture;
//rect : trect;
end; TLine =record
StartPt,EndPt :TPoint;
end; TForm1 = class(TForm)
ScrollBox1: TScrollBox;
Image1: TImage;
TreeView1: TTreeView;
ImageList1: TImageList;
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormCreate(Sender: TObject);
procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure TreeView1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
private
{ Private declarations }
pic : tpicture;
name : string;
drawing,moving,Lining : Boolean;
picnode : array of TNode;
ArrLine :array of TLine;
nodecount,nodeselectNo : integer;
LineCount,LineSelectNo :integer;
origin, movept :TPoint;
DrawingTool: TDrawingTool;
procedure DrawShape(TopLeft, BottomRight: TPoint; AMode: TPenMode);
procedure RefreshImage;
public
{ Public declarations }
end;var
Form1: TForm1;implementation{$R *.DFM}procedure TForm1.RefreshImage;
var i :integer;
beginend;procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
i : integer;
tmprect : trect;
begin
if button = mbleft then
begin
if drawing then
begin
image1.Canvas.Draw(x,y,pic.Graphic);
setlength(picNode,nodeCount+1);
picnode[nodecount].rectx1 := x;
picnode[nodecount].recty1 := y;
picnode[nodecount].rectx2 := x + pic.Width;
picnode[nodecount].recty2 := y + pic.Height;
picnode[nodecount].name := name;
picnode[nodecount].pic := tpicture.Create;
picnode[nodecount].pic := pic;
image1.Canvas.TextOut(picnode[nodecount].rectx1,picnode[nodecount].recty2,picnode[nodecount].name);
nodecount := nodecount + 1;
drawing := False;
end
else
begin
for i := 0 to nodecount do
begin
tmprect := rect(picnode[i].rectx1,picnode[i].recty1,picnode[i].rectx2,picnode[i].recty2);
if ptinrect(tmprect,point(x,y)) then
begin
moving := true;
nodeselectNo := i;
break;
end;
end;
end;
end else if Button =mbRight then
begin
for i := 0 to nodecount do
begin
tmprect := rect(picnode[i].rectx1,picnode[i].recty1,picnode[i].rectx2,picnode[i].recty2);
if ptinrect(tmprect,point(x,y)) then
begin
//moving := true;
nodeselectNo := i;
DrawingTool :=dtLine;
lining :=true;
Origin :=point(x,y);
MovePt := Origin;
break;
end;
end;
end;
end;procedure TForm1.FormCreate(Sender: TObject);
begin
nodecount := 0;
LineCount :=0;
setlength(picnode,30);
drawing := false;
moving := false;
Lining :=false;
end;procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
tmprect : trect;
i :integer;
CanLine :Boolean;
begin
CanLine :=False;
if button = mbleft then
begin
if moving then
begin
tmprect := rect(picnode[nodeselectno].rectx1,picnode[nodeselectno].recty1,picnode[nodeselectno].rectx2,picnode[nodeselectno].recty2);
image1.Canvas.FillRect(tmpRect);
image1.Canvas.Brush.Color := clWhite;
image1.Canvas.TextOut(picnode[nodeselectno].rectx1,picnode[nodeselectno].recty2,' ');
image1.Canvas.Draw(x,y,picnode[nodeselectno].pic.Graphic);
picnode[nodeselectno].rectx1 := x;
picnode[nodeselectno].recty1 := y;
picnode[nodeselectno].rectx2 := x + picnode[nodeselectno].pic.Width;
picnode[nodeselectno].recty2 := y + picnode[nodeselectno].pic.Height;
image1.Canvas.TextOut(picnode[nodeselectno].rectx1,picnode[nodeselectno].recty2,picnode[nodeselectno].name);
for i :=0 to Length(ArrLine)-1 do
begin
if ptInRect(tmpRect,ArrLine[i].StartPt) then
begin
DrawShape(Point(x,y),ArrLine[i].EndPt,PmCopy);
DrawShape(ArrLine[i].StartPt,ArrLine[i].EndPt,pmNotXor);
ArrLine[i].StartPt :=Point(x,y);
end else if ptInRect(tmpRect,ArrLine[i].EndPt) then
begin
DrawShape(ArrLine[i].StartPt,Point(x,y),PmCopy);
DrawShape(ArrLine[i].StartPt,ArrLine[i].EndPt,pmNotXor);
ArrLine[i].EndPt :=Point(x,y);
end;
end;
image1.Refresh;
moving := false;
end;
end else if button =mbRight then
begin
if lining then
begin
for i := 0 to nodecount do
begin
tmprect := rect(picnode[i].rectx1,picnode[i].recty1,picnode[i].rectx2,picnode[i].recty2);
if ptinrect(tmprect,point(x,y)) then
begin
CanLine :=True;
break;
end;
end;
if CanLine then
begin
DrawShape(Origin, Point(X, Y), pmCopy);
inc(LineCount);
setlength(ArrLine,LineCount);
ArrLine[LineCount-1].StartPt :=Origin;
ArrLine[LineCount-1].EndPt :=Point(x,y);
lining :=false;
end else
begin
DrawShape(Origin,Point(x,y),pmNotXor);
lining :=false;
end;
end;
end;
end;procedure TForm1.TreeView1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
i : integer;
bmp : tbitmap;
begin
for i := 0 to Treeview1.Items.Count - 1 do
begin
if Treeview1.Items[i].Selected then
begin
pic := TPicture.Create;
bmp :=TBitmap.Create;
ImageList1.GetBitmap(Treeview1.Items[i].ImageIndex,bmp);
//SelectIndex := i;
pic.Assign(bmp);
Drawing :=True;
name :=TreeView1.Items[i].Text;
bmp.Free;
end;
end;
end;procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
i : integer;
begin
pic.Free;
for i := 0 to nodecount-1 do
picnode[nodecount].pic.Free;
end;procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if lining then
begin
DrawShape(Origin, MovePt, pmNotXor);
MovePt := Point(X, Y);
DrawShape(Origin, MovePt, pmNotXor);
end;
end;procedure TForm1.DrawShape(TopLeft, BottomRight: TPoint; AMode: TPenMode);
begin
with Image1.Canvas do
begin
Pen.Mode := AMode;
case DrawingTool of
dtLine:
begin
Image1.Canvas.MoveTo(TopLeft.X, TopLeft.Y);
Image1.Canvas.LineTo(BottomRight.X, BottomRight.Y);
end;
dtRectangle: Image1.Canvas.Rectangle(TopLeft.X, TopLeft.Y, BottomRight.X,
BottomRight.Y);
dtEllipse: Image1.Canvas.Ellipse(Topleft.X, TopLeft.Y, BottomRight.X,
BottomRight.Y);
dtRoundRect: Image1.Canvas.RoundRect(TopLeft.X, TopLeft.Y, BottomRight.X,
BottomRight.Y, (TopLeft.X - BottomRight.X) div 2,
(TopLeft.Y - BottomRight.Y) div 2);
end;
end;
end;end.