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

请问各位专家,怎样在Delphi里画出类似PPT里荧光笔等效果?

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


發表:20
回覆:27
積分:14
註冊:2008-03-13

發送簡訊給我
#1 引用回覆 回覆 發表時間:2008-03-20 13:43:52 IP:58.37.xxx.xxx 訂閱
powerpoint在播放时,可以在屏幕上画图,画笔可以是圆珠笔,毡尖笔,荧光笔,感觉效果比在Delphi里直接用Lineto画要好多了

请问在delphi里可以实现这种效果吗?

非常期待您的指教,谢谢!

附加檔案:47e1f998acd2f_ppt.gif
編輯記錄
rainxie 重新編輯於 2008-03-21 09:50:45, 註解 無‧
taishyang 重新編輯於 2008-03-21 10:21:15, 註解 無‧
jow
尊榮會員


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

發送簡訊給我
#2 引用回覆 回覆 發表時間:2008-03-20 16:55:46 IP:210.66.xxx.xxx 訂閱
用TCanvas.Draw()試試...

[code delphi]
unit fMain;

interface
uses
Forms, StdCtrls, Classes, Controls, Graphics;

type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure FormDestroy(Sender: TObject);
private
bmp: TBitmap;
end;

var
Form1: TForm1;

implementation

uses SysUtils;

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
bmp := TBitmap.Create;
// bmp.LoadFromFile('TEST.BMP');
bmp.Width := 16;
bmp.Height := 16;
bmp.Canvas.Pen.Color := clRed;
bmp.Canvas.Brush.Color := clRed;
bmp.Canvas.Brush.Style := bsSolid;
bmp.Canvas.Ellipse(Rect(0,0,16,16));
// bmp.Canvas.Rectangle(Rect(0,0,16,16));
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
if bmp <> nil then FreeAndNil(bmp);
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if ssLeft in Shift then
begin
Canvas.CopyMode := cmSrcAnd;
Canvas.Draw(X-8, Y-8, bmp);
end;
end;

[/code]
rainxie
一般會員


發表:20
回覆:27
積分:14
註冊:2008-03-13

發送簡訊給我
#3 引用回覆 回覆 發表時間:2008-03-21 09:31:16 IP:58.37.xxx.xxx 訂閱
Dear Jow,

效果不太好,速度快了就不连续了,呵呵呵,不过还是很谢谢您的帮助

请问有没有这方面的控件啊?不好意思,我也找过,没有找到,菜鸟,惭愧

jow
尊榮會員


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

發送簡訊給我
#4 引用回覆 回覆 發表時間:2008-03-21 11:04:11 IP:210.66.xxx.xxx 訂閱
很久以前, 書中的範例...

[code delphi]
unit fMain;

interface

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

type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

FRendering: Boolean;
Org, next1: TPoint;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
Canvas.Pen.Color := clRed;
Canvas.Brush.Color := clRed;
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
FRendering := True;
Org := Point(X, Y);
next1 := Point(X, Y);
end;

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

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
w: Integer;
points: array[1..4] of TPoint;
begin
if FRendering then
begin
w := 1;
next1 := Point(X, Y);
points[1] := org;
points[2] := next1;
points[3] := Point(next1.X w, next1.Y w);
points[4] := Point(org.X w, org.Y w);
Canvas.Polygon(points);
org := Point(X, Y);
end;
end;

end.


[/code]
編輯記錄
jow 重新編輯於 2008-03-21 11:05:22, 註解 無‧
rainxie
一般會員


發表:20
回覆:27
積分:14
註冊:2008-03-13

發送簡訊給我
#5 引用回覆 回覆 發表時間:2008-03-21 12:48:43 IP:58.37.xxx.xxx 訂閱
Dear Jow,

这个不错,蛮好的,呵呵呵,非常感谢您!
这个论坛真不错,有您这么好心的人!

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