全國最多中醫師線上諮詢網站-台灣中醫網
發文 回覆 瀏覽次數:2669
推到 Plurk!
推到 Facebook!

在Timage控件中实现上图的拖动画虚框的效果?

答題得分者是:aquarius
sos_admin
版主


發表:121
回覆:697
積分:768
註冊:2003-07-23

發送簡訊給我
#1 引用回覆 回覆 發表時間:2003-11-09 10:50:43 IP:61.155.xxx.xxx 未訂閱
如何在Timage控件中实现上图的拖动画虚框的效果,并且鼠标松开后消失。 纪录鼠标画的这个框的两个对角在实际图中的位置,并且在图上对应位置画出这个框! 要求: 1、实现一个虚的框 2、画出这个框 谢谢! 我是这样做的
unit Unit1;    interface    uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, jpeg, ExtCtrls;
type
myrect=record
posx,posy,posx1,posy1,posx2,posy2:longint;
end;    type
  TForm1 = class(TForm)
    ScrollBox1: TScrollBox;
    Image1: TImage;
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
  private
  picrect:myrect;
    { Private declarations }
  public
    { Public declarations }
  end;    var
  Form1: TForm1;    implementation    {$R *.dfm}    procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
Screen.Cursor:=crHandPoint;//自己作个样式。    if button=mbLeft then
begin
//第一次单击坐标
picrect.posx1:=x;
picrect.posy1:=y;
//鼠标释放坐标[最后]
picrect.posx2:=x;
picrect.posy2:=y;
end;    end;    procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
rect:Trect;
toppoint:Tpoint;
buttompoint:Tpoint;
begin
//活动坐标
picrect.posx:=x;
picrect.posy:=y;    toppoint.X:= picrect.posx1;
toppoint.y:= picrect.posy1;
buttompoint.X:= picrect.posx;
buttompoint.y:= picrect.posy;    rect.TopLeft:=toppoint;
rect.BottomRight:=buttompoint;    if not ((picrect.posx1=-1) and (picrect.posy1=-1)) then  begin
image1.Canvas.DrawFocusRect(Rect);
end;
end;    procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
//鼠标释放坐标[最后]
picrect.posx2:=x;
picrect.posy2:=y;    //初始化
picrect.posx1:=-1;
picrect.posy1:=-1;    Screen.Cursor:=crDefault;    end;    procedure TForm1.FormCreate(Sender: TObject);
begin
ScrollBox1.DoubleBuffered :=true;
//初始化
picrect.posx1:=-1;
picrect.posy1:=-1;
end;    end.
可是效果太差了,请问有什么更好的方法!
AB
高階會員


發表:166
回覆:262
積分:125
註冊:2003-08-21

發送簡訊給我
#2 引用回覆 回覆 發表時間:2003-11-09 11:50:55 IP:61.64.xxx.xxx 未訂閱
試看看 這東西的原理 是否合用 【發表】網咖管理金剛組合版 http://delphi.ktop.com.tw/topic.php?TOPIC_ID=28622 【發表】動態移動控制項 http://delphi.ktop.com.tw/topic.php?TOPIC_ID=28541
taishyang
站務副站長


發表:377
回覆:5490
積分:4563
註冊:2002-10-08

發送簡訊給我
#3 引用回覆 回覆 發表時間:2003-11-09 13:05:35 IP:61.231.xxx.xxx 未訂閱
sos_admin您好: 有個範例是包子哥寫的,不過是BCB版本,供您參考 http://delphi.ktop.com.tw/topic.php?TOPIC_ID=34115 【發表】利用滑鼠截取 Image 的部分區域 BY RaynorPao 順心
sos_admin
版主


發表:121
回覆:697
積分:768
註冊:2003-07-23

發送簡訊給我
#4 引用回覆 回覆 發表時間:2003-11-09 17:07:05 IP:61.155.xxx.xxx 未訂閱
谢谢! 好像不能达到效果!
AB
高階會員


發表:166
回覆:262
積分:125
註冊:2003-08-21

發送簡訊給我
#5 引用回覆 回覆 發表時間:2003-11-10 00:25:56 IP:61.64.xxx.xxx 未訂閱
喔 真的是這樣嗎? 借你的圖來使用一下 已記錄的模版位置 解法方式 1 以動態OLE方式類似CAD或VSIO流程圖 2 使用delphi的Canvas畫出自己預設的虛線模具圖示 http://delphi.ktop.com.tw/topic.php?TOPIC_ID=22596 3 在此虛限元件上定義要抓的x,y資訊 並存下 如下範例的按鈕方式 http://delphi.ktop.com.tw/topic.php?TOPIC_ID=28622 4 【發表】利用滑鼠截取 Image 的部分區域 BY RaynorPao 當然也是x,y的應用 行不行當然就看你自己 找找KTOP的舊資料 與 vcl 繼承有關的 一直偵測 不如只測 滑鼠按下或放開 最困難的問題 是OLE的引用 這部份KTOP比較沒有資料 不過可以去日本站找找 發表人 - ab 於 2003/11/10 00:53:56
sos_admin
版主


發表:121
回覆:697
積分:768
註冊:2003-07-23

發送簡訊給我
#6 引用回覆 回覆 發表時間:2003-11-10 10:42:34 IP:61.155.xxx.xxx 未訂閱
to AB 谢谢! 您所提供资料不是我想要的,我是想要在Timage上画出虚线! 虚线的对应位置应该和这张图实际大小有关,不是和这个Timage所处的位置或显示区域有关! 条件: 1、我在做鼠标移动或其他动作的时候,对应Tbitmap中图形我的鼠标所在位置 两则关系不一定相等 2\在Timage中所画的图,不受timage所控制,也就是画在其中的Tbitmap中。 3、要求画虚线,随鼠标移动而动态改变大小。
AB
高階會員


發表:166
回覆:262
積分:125
註冊:2003-08-21

發送簡訊給我
#7 引用回覆 回覆 發表時間:2003-11-10 11:07:49 IP:61.221.xxx.xxx 未訂閱
sos_admin 兄 安想安應該是知道的 不過無法提供給你tset 你再清楚看看 那4張圖片 那可不是用影像合成 去背喔 由其是第4張 決對符合你說的 所有白色上的 都是可透過滑鼠 隨心異動 與儲存物件x,y並反復使用 由於每個都是 動態產生的 所以你可以把他當成每個都是 Timage 連你說的虛線也是 隨滑鼠x,y自行異動 而外部Timage當然也是ok的 其實全部資訊都可記錄 讓下次要用時 只載各物件x,y資料 這樣把 你可以去問問 1 ccchen (cc欠)= 寶物之人 請拆中國字 哈哈 2 一位delphiwww 資深老delphi 3 寫 麥頭工具的 hahalin 列印版主 問問他們
aquarius
資深會員


發表:3
回覆:347
積分:330
註冊:2003-05-21

發送簡訊給我
#8 引用回覆 回覆 發表時間:2003-11-10 11:20:19 IP:211.23.xxx.xxx 未訂閱
試試這個吧!!     
procedure DoDrawRect(can:TCanvas;iX1, iY1, iX2, iY2:integer;dwMode:DWORD) ;
begin
  case dwMode of
    1: // xor
      begin
      can.Pen.Color:=clBlue ;
      can.Pen.Mode:=pmXor ;
      can.Pen.Style:=psDot ;
      can.Brush.Style:=bsClear ;
      end ;
    2 : // Draw
      begin
      can.Pen.Color:=clBlack ;
      can.Pen.Mode:=pmCopy ;
      can.Pen.Style:=psSolid ;
      can.Brush.Style:=bsClear ;
      end ;
    else
      begin
      can.Pen.Color:=clBlack ;
      can.Pen.Mode:=pmCopy ;
      can.Pen.Style:=psSolid ;
      can.Brush.Style:=bsSolid ;
      can.Brush.Color:=clWhite ;
      end ;
    end ;      can.Rectangle(iX1,iY1,iX2,iY2) ;
end ;    procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  iStartX:=x ;
  iStartY:=y ;      iOldX:=x ;
  iOldY:=y ;      bDown:=true ;
end;    procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if not bDown then
    exit ;      DoDrawRect(Image1.Canvas,iStartX,iStartY,iOldX,iOldY,1) ;      iOldX:=x ;
  iOldy:=y ;      DoDrawRect(Image1.Canvas,iStartX,iStartY,iOldX,iOldY,1) ;
end;    procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  bDown:=false ;
  DoDrawRect(Image1.Canvas,iStartX,iStartY,iOldX,iOldY,1) ;
  DoDrawRect(Image1.Canvas,iStartX,iStartY,X,Y,2) ;
end;    procedure TForm1.FormCreate(Sender: TObject);
begin
  bDown:=false ;
end;
 
...Aquarius
------
水瓶男的blog: http://791909.blogspot.com
sos_admin
版主


發表:121
回覆:697
積分:768
註冊:2003-07-23

發送簡訊給我
#9 引用回覆 回覆 發表時間:2003-11-10 11:40:48 IP:61.155.xxx.xxx 未訂閱
哈哈~~终于实现了!可以画虚框、实框、园等任意几何图形! 只不过不是采用原生timage,而是自己做的一个比timage功能更强的看图控件! 主要是受AB兄的几幅漂亮图片启发哦!
AB
高階會員


發表:166
回覆:262
積分:125
註冊:2003-08-21

發送簡訊給我
#10 引用回覆 回覆 發表時間:2003-11-10 11:50:21 IP:61.221.xxx.xxx 未訂閱
sos_admin 兄 有來歷  看來 陰陽師 這次又亂攪了   不過
sos_admin
版主


發表:121
回覆:697
積分:768
註冊:2003-07-23

發送簡訊給我
#11 引用回覆 回覆 發表時間:2003-11-10 11:54:04 IP:61.155.xxx.xxx 未訂閱
to aquarius  感谢,您用原生的Timage也实现了这样效果!    到该结案的时候,我不知道该将这个分给谁;这样吧!我再问一个相关问题。 谁是第一个答对的,这题分就给他了
AB
高階會員


發表:166
回覆:262
積分:125
註冊:2003-08-21

發送簡訊給我
#12 引用回覆 回覆 發表時間:2003-11-10 12:00:23 IP:61.221.xxx.xxx 未訂閱
sos_admin 兄  賣給亂啦 aquarius 兄 的方式 加上其他判斷式 就能達到你要的    分數阿 陰陽師 沒興趣     安是來亂ㄟ  該給aquarius 兄的 就 別再 學安亂了 
sos_admin
版主


發表:121
回覆:697
積分:768
註冊:2003-07-23

發送簡訊給我
#13 引用回覆 回覆 發表時間:2003-11-10 13:17:57 IP:61.155.xxx.xxx 未訂閱
呵呵~~ to AB 尊重您的意见!
AB
高階會員


發表:166
回覆:262
積分:125
註冊:2003-08-21

發送簡訊給我
#14 引用回覆 回覆 發表時間:2003-11-10 13:20:24 IP:61.221.xxx.xxx 未訂閱
aquarius 兄 的這篇 很有看頭 慢慢品味 http://delphi.ktop.com.tw/topic.php?TOPIC_ID=37283 有味有味 贊
chenliyan163
一般會員


發表:30
回覆:30
積分:12
註冊:2003-09-15

發送簡訊給我
#15 引用回覆 回覆 發表時間:2003-11-11 10:02:07 IP:61.175.xxx.xxx 未訂閱
http://delphi.ktop.com.tw/topic.php?TOPIC_ID=40289 大家帮帮我
系統時間:2024-05-04 17:53:19
聯絡我們 | Delphi K.Top討論版
本站聲明
1. 本論壇為無營利行為之開放平台,所有文章都是由網友自行張貼,如牽涉到法律糾紛一切與本站無關。
2. 假如網友發表之內容涉及侵權,而損及您的利益,請立即通知版主刪除。
3. 請勿批評中華民國元首及政府或批評各政黨,是藍是綠本站無權干涉,但這裡不是政治性論壇!