線上訂房服務-台灣趴趴狗聯合訂房中心
發文 回覆 瀏覽次數:1962
推到 Plurk!
推到 Facebook!

Canvas 取點 或其他替代方式

答題得分者是:jow
deemster
一般會員


發表:4
回覆:15
積分:3
註冊:2005-01-24

發送簡訊給我
#1 引用回覆 回覆 發表時間:2011-05-26 20:55:43 IP:61.153.xxx.xxx 訂閱
<!--[if gte mso 9]><xml> </xml><![endif]--><!--[if gte mso 10]> <style> /* Style Definitions */ table.MsoNormalTable {mso-style-name:普通表格; mso-tstyle-rowband-size:0; mso-tstyle-colband-size:0; mso-style-noshow:yes; mso-style-priority:99; mso-style-qformat:yes; mso-style-parent:""; mso-padding-alt:0cm 5.4pt 0cm 5.4pt; mso-para-margin:0cm; mso-para-margin-bottom:.0001pt; mso-pagination:widow-orphan; font-size:10.5pt; mso-bidi-font-size:11.0pt; font-family:"Calibri","sans-serif"; mso-ascii-font-family:Calibri; mso-ascii-theme-font:minor-latin; mso-hansi-font-family:Calibri; mso-hansi-theme-font:minor-latin; mso-bidi-font-family:"Times New Roman"; mso-bidi-theme-font:minor-bidi; mso-font-kerning:1.0pt;} </style> <xml> </xml><![endif]--><!--[if gte mso 9]><xml> </xml><![endif]--> 各位高手先進你們好
小弟目前遇到幾個問題,一直找不到適當的解決方式,不得已上來請求大家的協助,還望高手們能指點一下小弟

先貼上部分源碼
Begin
TextCanvas := TBitmap.Create;
TextCanvas.Canvas.Font.Size := FontSize;
TextCanvas.Canvas.Font.Name := FontName;
TextCanvas.Canvas.Font.Color := RGB(0,0,0);
TextCanvas.Canvas.Brush.Color := clWhite;
TextCanvas.Canvas.Handle := GetDC(0);
W := TextCanvas.Canvas.TextWidth(TextString);
H := TextCanvas.Canvas.TextHeight(TextString);
If W Mod 8 > 0 Then Begin
HexW := (W div 8) 1;
End Else Begin
HexW := (W div 8);
End;
If H Mod 8 > 0 Then Begin
HexH := (H div 8) 1;
End Else Begin
HexH := (H div 8);
End;
TextCanvas.Canvas.TextOut(0,0,TextString);
// 開始處理文字字串的部分資訊
For I := 0 To HexH * 8 -1 do Begin
FontCode := ''; ConverFontCode := '';
For J := 0 To HexW * 8 -1 do Begin
If TextCanvas.Canvas.Pixels[J,I] = RGB(255,255,255) Then Begin
FontCode := FontCode '0';
End Else Begin
FontCode := FontCode '1';
End;
If Length(FontCode) = 8 Then Begin
A := A FontCode;
FontCode := '';
End;
End;
End;
End;

以上,是整個源碼的部分

1、原本小弟是希望不要在畫面上有任何的顯示,直接在記憶體裡做完畫字的動作,可是卻發現,會在Form上,把畫布顯示出來。這個該如何解決?
2、由於最終的目的是取得每一點的值,所以如果在沒有完成取點動作前就切換畫面,整個取點動作就會失敗
3、取點的速度非常的慢

以上三點,小的真的試了好久,只好上來求各位高手給予賜教
cancer
高階會員


發表:58
回覆:319
積分:190
註冊:2004-07-31

發送簡訊給我
#2 引用回覆 回覆 發表時間:2011-05-30 09:13:38 IP:220.128.xxx.xxx 未訂閱
Hello, 全部程式碼只用到 TBitmap 元件,怎麼可能自動顯示在 TForm 上面?
deemster
一般會員


發表:4
回覆:15
積分:3
註冊:2005-01-24

發送簡訊給我
#3 引用回覆 回覆 發表時間:2011-05-31 07:35:53 IP:220.189.xxx.xxx 訂閱
您好

小弟原本是使用TCanvas,後來改用TBitbmp。
主要是希望畫面上“不要”出現這個原件,直接在後端做完取點的工作
怎想不管用了哪一個,都會出現在Form上面。。。。

取點的速度也慢,無法有效處理太多的東西
rick060
高階會員


發表:2
回覆:112
積分:217
註冊:2009-11-17

發送簡訊給我
#4 引用回覆 回覆 發表時間:2011-05-31 09:20:54 IP:60.250.xxx.xxx 未訂閱
 1. 會顯示在畫面是 因為 TextCanvas.Canvas.Handle := GetDC(0); 它不是 form. 要搞清楚
2.input ? output ?
3.哪邊慢
deemster
一般會員


發表:4
回覆:15
積分:3
註冊:2005-01-24

發送簡訊給我
#5 引用回覆 回覆 發表時間:2011-05-31 14:46:40 IP:61.153.xxx.xxx 訂閱

===================引 用 rick060 文 章===================
1. 會顯示在畫面是 因為TextCanvas.Canvas.Handle:=GetDC(0); 它不是 form. 要搞清楚
您好,这個部分我是知道的。之前是採用了TCanvas的關係,所以改用TBitmap時,忘記拿掉了。所以這個顯示出來的問題解決了。
2.input ? output ?
我主要的是要取得下面這個東西
For I := 0 To HexH * 8 -1 do Begin
FontCode := ''; ConverFontCode := '';
For J := 0 To HexW * 8 -1 do Begin
If TextCanvas.Canvas.Pixels[J,I] = RGB(255,255,255) Then Begin
FontCode := FontCode '0';
End Else Begin
FontCode := FontCode '1';
End;
If Length(FontCode) = 8 Then Begin
A := A FontCode;
FontCode := '';
End;
End;

3.哪邊慢

這一段執行的非常慢,小弟不曉得除了以這樣的取點方式之外,還有沒有更快的方法

deemster
一般會員


發表:4
回覆:15
積分:3
註冊:2005-01-24

發送簡訊給我
#6 引用回覆 回覆 發表時間:2011-05-31 14:56:30 IP:61.153.xxx.xxx 訂閱

===================引 用 rick060 文 章===================
1. 會顯示在畫面是 因為TextCanvas.Canvas.Handle:=GetDC(0); 它不是 form. 要搞清楚
不好意思,剛剛試了一下,如果取消這一行,畫面是不會出現我所畫出來的字。但在下面取點的時候,就會全部取到黑色的點。也就是說A 全部等於 1
2.input ? output ?
3.哪邊慢
ckc5168
一般會員


發表:3
回覆:10
積分:2
註冊:2002-08-30

發送簡訊給我
#7 引用回覆 回覆 發表時間:2011-06-01 17:54:45 IP:114.32.xxx.xxx 訂閱
這個程式看起來是要看貼上字體的黑色有多少點
deemster
一般會員


發表:4
回覆:15
積分:3
註冊:2005-01-24

發送簡訊給我
#8 引用回覆 回覆 發表時間:2011-06-02 07:04:30 IP:220.134.xxx.xxx 訂閱
是的,非常正確哦!
jow
尊榮會員


發表:66
回覆:751
積分:1253
註冊:2002-03-13

發送簡訊給我
#9 引用回覆 回覆 發表時間:2011-06-02 10:58:22 IP:112.104.xxx.xxx 未訂閱

[code delphi]
procedure TfrmMain.Button1Click(Sender: TObject);
const
XXX = 'X Y Z';
SSS: array[Boolean] of string = (' ','@');
var
I,J: Integer;
S: string;
b: TBitmap;
L: TStringList;
begin
B := TBitmap.Create;
try
with B,Canvas do
begin
Font.Size := 12;
Font.Name := 'ARIAL';
Font.Color := clBlack;
Brush.Color := clWhite;
Width := TextWidth(XXX);
Height := TextHeight(XXX);
TextOut(0,0,XXX);
end;
//開始處理文字字串的部分資訊
L := TStringList.Create;
try
with B,Canvas do
begin
for I := 0 to Height-1 do
begin
for J := 0 to Width-1 do
S := S SSS[Pixels[J,I]<>Brush.Color];
L.Add(S);
S := '';
end;
end;
ShowMessage(L.Text);
finally
FreeAndNil(L);
end;
finally
FreeAndNil(B);
end;
end;
[/code]


deemster
一般會員


發表:4
回覆:15
積分:3
註冊:2005-01-24

發送簡訊給我
#10 引用回覆 回覆 發表時間:2011-06-02 14:50:40 IP:61.153.xxx.xxx 訂閱
非常感謝大大提供的解法

小弟試了一下,速度上完全提升了。
但取得的點,卻全是黑點。而沒有白點。

看似 TextCanvas.Canvas.Handle := GetDC(0); 這一個的關係

有它,速度慢,取點正常
沒它,速度快,取點失敗


jow
尊榮會員


發表:66
回覆:751
積分:1253
註冊:2002-03-13

發送簡訊給我
#11 引用回覆 回覆 發表時間:2011-06-03 16:25:35 IP:112.104.xxx.xxx 未訂閱

[code delphi]
procedure TfrmMain.SHOW(THE_PIXEL_FORMAT: TPixelFormat);
const
XXX = 'X Y Z';
var
I,J: Integer;
S: string;
b: TBitmap;
L: TStringList;
begin
B := TBitmap.Create;
try
with B,Canvas do
begin
//
PixelFormat := THE_PIXEL_FORMAT;
//
Font.Size := 12;
Font.Name := 'ARIAL';
Font.Color := clBlack;
Brush.Color := clWhite;
Width := TextWidth(XXX);
Height := TextHeight(XXX);
TextOut(0,0,XXX);
end;
//開始處理文字字串的部分資訊
L := TStringList.Create;
try
with B,Canvas do
begin
for I := 0 to Height-1 do
begin
for J := 0 to Width-1 do
begin
if Pixels[J,I]=Font.Color then S := S '@'
else if Pixels[J,I]=Brush.Color then S := S ' '
else S := S '。';
end;
L.Add(S);
S := '';
end;
end;
ShowMessage(L.Text);
finally
FreeAndNil(L);
end;
finally
FreeAndNil(B);
end;
end;

procedure TfrmMain.Button1Click(Sender: TObject);
begin
SHOW(pf1bit);
SHOW(pf24bit);
end;

[/code]



編輯記錄
jow 重新編輯於 2011-06-03 02:30:32, 註解 無‧
deemster
一般會員


發表:4
回覆:15
積分:3
註冊:2005-01-24

發送簡訊給我
#12 引用回覆 回覆 發表時間:2011-06-07 09:39:04 IP:61.153.xxx.xxx 訂閱
感謝Jow大大一直以來的協助

今天才進辦公室做了測試。
加上了jow大大後來追加進來的語法。

大概介紹一下:
如果 取點的顏色 = Font.Color ,則設定為 1
取點的顏色 = Brush.Color ,則設定為 0
如果不為上面的兩種顏色, 則設定為 2

發現,如果不加 TextCanvas.Canvas.Handle := GetDC(0); 時,取點完全是 2
如果加上了,則取點為1跟0 ,2為少數。

是小弟的環境造成取點不正常嗎? 小弟使用 W7 Delphi2010
deemster
一般會員


發表:4
回覆:15
積分:3
註冊:2005-01-24

發送簡訊給我
#13 引用回覆 回覆 發表時間:2011-06-12 21:48:30 IP:115.228.xxx.xxx 訂閱
還有沒有其他大大高手能告訴小弟怎麼解決這樣的問題?

小弟肯定大大們給小弟協助
deemster
一般會員


發表:4
回覆:15
積分:3
註冊:2005-01-24

發送簡訊給我
#14 引用回覆 回覆 發表時間:2011-06-23 11:32:06 IP:61.153.xxx.xxx 訂閱
在此非常感謝Jow大大及所有給予小弟幫助與建議的朋友們

Jow大大的方法,雖然沒有解決小弟的問題,不過反而讓小弟從別的方向思考回來
除了解決了這個問題,更解決了其他新的問題。

再次謝謝各位的幫助

開心,還是台灣朋友們好。。。。
系統時間:2017-12-12 2:49:02
聯絡我們 | Delphi K.Top討論版
本站聲明
1. 本論壇為無營利行為之開放平台,所有文章都是由網友自行張貼,如牽涉到法律糾紛一切與本站無關。
2. 假如網友發表之內容涉及侵權,而損及您的利益,請立即通知版主刪除。
3. 請勿批評中華民國元首及政府或批評各政黨,是藍是綠本站無權干涉,但這裡不是政治性論壇!