在RichEdit1中加入背景十字線 |
|
答題得分者是：qoo1234
|
|
banson1716
高階會員   發表：55 回覆：182 積分：167 註冊：2002-04-14 發送簡訊給我 |
|
|
Rain
資深會員 發表：31 回覆：236 積分：268 註冊：2003-02-17 發送簡訊給我 |
在RichEdit中加入兩個Shape：
var
ShapeX, ShapeY: TShape; FormCreate：
ShapeX := TShape.Create(Self);
ShapeY := TShape.Create(Self);
with ShapeX do
begin
Parent := RichEdit1;
Brush.Color := clBlack;
Width := 1;
Height := 1000;
Left := RichEdit1.Width div 2;
end;
with ShapeY do
begin
Parent := RichEdit1;
Brush.Color := clBlack;
Height := 1;
Width := 1000;
Top := RichEdit1.Height div 2;
end; FormDestroy:
ShapeX.Free;
ShapeY.Free; RichEdit OnKeyDown:
if Key = VK_LEFT then ShapeX.Left := ShapeX.Left-1;
if Key = VK_RIGHT then ShapeX.Left := ShapeX.Left 1;
if Key = VK_UP then ShapeY.Top := ShapeY.Top-1;
if Key = VK_DOWN then ShapeY.Top := ShapeY.Top 1;
這樣存在的一個問題是RichEdit中若要輸入什麼還要再進行處理，如果使用TMemo則沒有這個問題。
|
|
banson1716
高階會員 發表：55 回覆：182 積分：167 註冊：2002-04-14 發送簡訊給我 |
|
|
qoo1234
版主 發表：256 回覆：1167 積分：659 註冊：2003-02-24 發送簡訊給我 |
unit Unit1; interface uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls; type
TForm1 = class(TForm)
RichEdit1: TRichEdit;
procedure RichEdit1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure RichEdit1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
private
{ Private declarations }
procedure DrawNew;
procedure DrawOld;
public
{ Public declarations }
end; var
Form1: TForm1;
old:TPoint;
new:TPoint; implementation {$R *.dfm}
procedure TForm1.DrawNew;
var
c: TCanvas;
dc:hdc;
i:integer;
begin
c := TControlCanvas.Create;
TControlCanvas(c).Control := RichEdit1;
dc:=getdc(RichEdit1.Handle);
c.Handle:=dc;
c.Brush.Style := bsClear;
c.MoveTo(new.x,0);
c.LineTo(new.x,ClientHeight);
c.MoveTo(0,new.y);
c.LineTo(ClientWidth,new.y);
c.Font.Name:='細明體';
c.Font.Size:=12;
c.Font.Color:=clblack;
For i:=0 to RichEdit1.lines.count -1 do
c.TextOut(0,i*(c.TextHeight('a')),RichEdit1.Lines[i]);
c.Free;
end; procedure TForm1.DrawOld;
var
c: TCanvas;
dc:hdc;
i:integer;
begin
c := TControlCanvas.Create;
TControlCanvas(c).Control := RichEdit1;
dc:=getdc(RichEdit1.Handle);
c.Handle:=dc;
c.Brush.Style := bsClear;
c.Pen.Mode:=pmNotXor;
c.MoveTo(old.x,0);
c.LineTo(old.x,ClientHeight);
c.MoveTo(0,old.y);
c.LineTo(ClientWidth,old.y);
c.Font.Name:='細明體';
c.Font.Size:=12;
c.Font.Color:=clblack;
For i:=0 to RichEdit1.lines.count -1 do
c.TextOut(0,i*(c.TextHeight('a')),RichEdit1.Lines[i]);
c.Free;
end; procedure TForm1.RichEdit1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
new:=point(x,y);
DrawOld;
DrawNew;
old:=new;
end; procedure TForm1.RichEdit1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
var
myKey:integer;
begin
myKey:=ord(key);
case myKey of
37: new:=Point(new.x-1,new.y);
38: new:=Point(new.X,new.y-1);
39: new:=Point(new.x 1,new.y);
40: new:=Point(new.x,new.y 1);
end;
Cursor:=crCross;
DrawOld;
DrawNew;
old:=new;
end; end. //這樣寫也尚可而已～懂得人改改看..僅供參考.. |
發表時間：2003-08-13 11:54:11
IP:218.175.xxx.xxx 未訂閱
系統時間：2024-05-20 4:51:17
聯絡我們 | Delphi K.Top討論版
| 本站聲明 |
|
1. 本論壇為無營利行為之開放平台，所有文章都是由網友自行張貼，如牽涉到法律糾紛一切與本站無關。 2. 假如網友發表之內容涉及侵權，而損及您的利益，請立即通知版主刪除。 3. 請勿批評中華民國元首及政府或批評各政黨，是藍是綠本站無權干涉，但這裡不是政治性論壇！ |