圖片問題 |
|
答題得分者是：st33chen
|
|
allan0208
一般會員   發表：10 回覆：10 積分：4 註冊：2007-12-13 發送簡訊給我 |
|
|
st33chen
尊榮會員  發表：15 回覆：591 積分：1201 註冊：2005-09-30 發送簡訊給我 |
您好,
圖處理我也是初學, 以下的例子我實測可行, 但是只適用 bmp 檔, 且圈楕圓時會閃爍, 還有改進空間. 先拉二個 timage, 一個 tbutton, 皆不改名. unit img1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, jpeg; type TForm1 = class(TForm) Image1: TImage; Image2: TImage; Button1: TButton; procedure Button1Click(Sender: TObject); procedure Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure Image1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); private { Private declarations } procedure myellipse(cnvs:TCanvas; xx0, xy0, xx2, xy2:integer); public { Public declarations } end; var Form1: TForm1; x0, y0, x2, y2, x1, y1 : integer; mousedn : boolean; implementation {$R *.dfm} procedure TForm1.Button1Click(Sender: TObject); var Bmp : TBitmap; FRgn :HRGN; begin // 先刪除選擇虛線 myellipse(image1.Canvas, x0, y0, x2, y2); // image2 清空 // image2.Picture := nil; // 保證 x0,y0 為左上 if x2 < x0 then begin x1:=x0; x0:=x2; x2:=x1; end; if y2 < y0 then begin y1:=y0; y0:=y2; y2:=y1; end; // copy 用 bmp Bmp := tbitmap.Create; Bmp.PixelFormat :=Image1.Picture.Bitmap.PixelFormat; Bmp.Width := x2; Bmp.Height := y2; // do copy BitBlt(Bmp.Canvas.Handle,0,0,bmp.width,bmp.height,Image1.Canvas.Handle,0,0,SRCCOPY); // 設 paste 區域 FRgn :=CreateEllipticRgn(x0, y0, x2, y2); SelectClipRgn(Image2.Canvas.Handle, FRgn); image2.Canvas.Draw(0,0,Bmp); // 挖掉原圖 copy 掉的區域 bmp.free; Bmp := tbitmap.Create; Bmp.PixelFormat :=Image1.Picture.Bitmap.PixelFormat; Bmp.Width := x2; Bmp.Height := y2; SelectClipRgn(Image1.Canvas.Handle, FRgn); Image1.Canvas.Draw(0,0,Bmp); // free resource Bmp.Free; DeleteObject(FRgn); end; procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin form1.DoubleBuffered := true; // 避免閃爍 x0 := x; y0 := y; x1 :=x; y1 :=y; mousedn := true; end; procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin mousedn := false; x2 :=x; y2 :=y; end; procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin if mousedn then begin myellipse(image1.Canvas, x0, y0, x1, y1); x1 := x; y1 := y; myellipse(image1.Canvas, x0, y0, x1, y1); end; end; procedure tform1.myellipse(cnvs:TCanvas; xx0, xy0, xx2, xy2:integer); begin cnvs.Pen.Color:=clred; cnvs.Pen.Mode:=pmXor ; cnvs.Pen.Style:=psDot ; cnvs.Brush.Style:=bsClear ; cnvs.Ellipse(xx0, xy0, xx2, xy2); // cnvs.Rectangle(xx0, xy0, xx2, xy2); end ; end. 參考一下.
------
IS IT WHAT IT IS 我是 李慕白 請倒著唸. 又想把老話拿出來說, 請用台語發音 : 專家專家全是ROBOT CAR (滷肉腳啦); 都已接手這麼久了, 績效還是那麼爛, 講話還那麼大聲. |
|
allan0208
一般會員 發表：10 回覆：10 積分：4 註冊：2007-12-13 發送簡訊給我 |
不好意思
我用匯入圖檔後 在用你的例子 圖沒有任何的改變 是我漏掉什麼了嗎？ ===================引 用 st33chen 文 章=================== 您好,
圖處理我也是初學, 以下的例子我實測可行, 但是只適用 bmp 檔, 且圈楕圓時會閃爍, 還有改進空間. 先拉二個 timage, 一個 tbutton, 皆不改名. unit img1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, jpeg; type TForm1 = class(TForm) Image1: TImage; Image2: TImage; Button1: TButton; procedure Button1Click(Sender: TObject); procedure Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure Image1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); private { Private declarations } procedure myellipse(cnvs:TCanvas; xx0, xy0, xx2, xy2:integer); public { Public declarations } end; var Form1: TForm1; x0, y0, x2, y2, x1, y1 : integer; mousedn : boolean; implementation {$R *.dfm} procedure TForm1.Button1Click(Sender: TObject); var Bmp : TBitmap; FRgn :HRGN; begin // 先刪除選擇虛線 myellipse(image1.Canvas, x0, y0, x2, y2); // image2 清空 // image2.Picture := nil; // 保證 x0,y0 為左上 if x2 < x0 then begin x1:=x0; x0:=x2; x2:=x1; end; if y2 < y0 then begin y1:=y0; y0:=y2; y2:=y1; end; // copy 用 bmp Bmp := tbitmap.Create; Bmp.PixelFormat :=Image1.Picture.Bitmap.PixelFormat; Bmp.Width := x2; Bmp.Height := y2; // do copy BitBlt(Bmp.Canvas.Handle,0,0,bmp.width,bmp.height,Image1.Canvas.Handle,0,0,SRCCOPY); // 設 paste 區域 FRgn :=CreateEllipticRgn(x0, y0, x2, y2); SelectClipRgn(Image2.Canvas.Handle, FRgn); image2.Canvas.Draw(0,0,Bmp); // 挖掉原圖 copy 掉的區域 bmp.free; Bmp := tbitmap.Create; Bmp.PixelFormat :=Image1.Picture.Bitmap.PixelFormat; Bmp.Width := x2; Bmp.Height := y2; SelectClipRgn(Image1.Canvas.Handle, FRgn); Image1.Canvas.Draw(0,0,Bmp); // free resource Bmp.Free; DeleteObject(FRgn); end; procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin form1.DoubleBuffered := true; // 避免閃爍 x0 := x; y0 := y; x1 :=x; y1 :=y; mousedn := true; end; procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin mousedn := false; x2 :=x; y2 :=y; end; procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin if mousedn then begin myellipse(image1.Canvas, x0, y0, x1, y1); x1 := x; y1 := y; myellipse(image1.Canvas, x0, y0, x1, y1); end; end; procedure tform1.myellipse(cnvs:TCanvas; xx0, xy0, xx2, xy2:integer); begin cnvs.Pen.Color:=clred; cnvs.Pen.Mode:=pmXor ; cnvs.Pen.Style:=psDot ; cnvs.Brush.Style:=bsClear ; cnvs.Ellipse(xx0, xy0, xx2, xy2); // cnvs.Rectangle(xx0, xy0, xx2, xy2); end ; end. 參考一下. |
|
st33chen
尊榮會員 發表：15 回覆：591 積分：1201 註冊：2005-09-30 發送簡訊給我 |
我不知您是如何做
我的作法是 1. 開一個新 project 2. form 上拉 image1, image2, button1 3. 按 image1 的 picture, 挑一個 .bmp 的檔, 這時 image1 有圖, image2 沒有圖 4. doubleclick image1 的 mousedown 事件, mouseup 事件, mousemove 事件 以產生 空的 procedure 把 例子中的 程式碼 分別 copy 到 適當的地方. 5. doubleclick button1 以產生空的 button1click procedure. 把 例子中的 程式碼 copy 到裡面 6. 自行新增 procedure tform1.myellipse(cnvs:TCanvas; xx0, xy0, xx2, xy2:integer); 包括宣告及內容 7. 執行 8. 先在 image1 畫出一個 虛線圓或楕圖 9. 按 button1 我測 bmp 檔是可以的, 您再測測看, 不行的話仔細檢查一下
------
IS IT WHAT IT IS 我是 李慕白 請倒著唸. 又想把老話拿出來說, 請用台語發音 : 專家專家全是ROBOT CAR (滷肉腳啦); 都已接手這麼久了, 績效還是那麼爛, 講話還那麼大聲.
編輯記錄
st33chen 重新編輯於 2008-12-25 14:01:18， 註解 無‧
|
|
allan0208
一般會員 發表：10 回覆：10 積分：4 註冊：2007-12-13 發送簡訊給我 |
謝謝你！！我用好了
===================引 用 st33chen 文 章=================== 我不知您是如何做 我的作法是 1. 開一個新 project 2. form 上拉 image1, image2, button1 3. 按 image1 的 picture, 挑一個 .bmp 的檔, 這時 image1 有圖, image2 沒有圖 4. doubleclick image1 的 mousedown 事件, mouseup 事件, mousemove 事件 以產生 空的 procedure 把 例子中的 程式碼 分別 copy 到 適當的地方. 5. doubleclick button1 以產生空的 button1click procedure. 把 例子中的 程式碼 copy 到裡面 6. 自行新增 procedure tform1.myellipse(cnvs:TCanvas; xx0, xy0, xx2, xy2:integer); 包括宣告及內容 7. 執行 8. 先在 image1 畫出一個 虛線圓或楕圖 9. 按 button1 我測 bmp 檔是可以的, 您再測測看, 不行的話仔細檢查一下 |
發表時間：2008-12-23 12:17:47
IP:192.192.xxx.xxx 訂閱
系統時間：2024-04-29 11:05:15
聯絡我們 | Delphi K.Top討論版
| 本站聲明 |
|
1. 本論壇為無營利行為之開放平台，所有文章都是由網友自行張貼，如牽涉到法律糾紛一切與本站無關。 2. 假如網友發表之內容涉及侵權，而損及您的利益，請立即通知版主刪除。 3. 請勿批評中華民國元首及政府或批評各政黨，是藍是綠本站無權干涉，但這裡不是政治性論壇！ |