P
payforme
Unregistered / Unconfirmed
GUEST, unregistred user!
这是此部分完整的代码，不知道大侠们有没有耐心看完！我跟踪了一下，发现每次问题都出在DrawTextPic函数内部的fTextbmp.Canvas.FillRect(Rect(0,0,fTextbmp.Width,fTextbmp.Height));或 fTextbmp.Canvas.TextOut(1,1,fText.Text); 语句。麻烦各位大侠帮忙分析一下。
unit TextPic;
interface
uses Windows,Graphics,Math,Classes,Controls,StdCtrls,ExtCtrls,Messages,SysUtils,
PicConst,PicBase,PicFuns, BmpFuns, Variants,Forms,Dialogs;
const
FOCUS_NUM=8;
type
TTextPic=Class(TPicBase)
private
StartPos:TPoint;
EndPos:TPoint;
fText:TTextInfo; //String; //wang 2006-1-4 文字内容，自定义的记录类型。
fHollow: Boolean; //空心
fSided: Boolean; //轮廓
fView3D: Boolean; //3D效果
fBkColor: TColor; //背景颜色
//
oldsp,oldep:TPoint;
FocusPoint:Array[1..FOCUS_NUM] of TPoint;
fEdit: TEdit; //输入框
fTextbmp: TBitMap; //图象
fCanvas:TCanvas;
fInputMode:Boolean; //图象文字输入状态
fEditMode: Boolean; //修改模式
fEditParent: TObject; //fEdit的parent;
procedure GetFocusPoints;
procedure DrawBitmapToCanvas(aCanvas:TCanvas;DRect:TRect);
procedure SetTextPicText(V:TTextInfo);
procedure SetTextPicRect(StartPoint,endPoint:TPoint);
function GetEditShowing:Boolean;
function GetEditText:String;
public
fDevTypeID:integer;
DevID,ParaID:integer;
public
constructor Create(aEditParent:TObject);
destructor Destroy; override;
procedure DrawPic(ACanvas:TCanvas); override; //在acanvas上画图
procedure MovePic(ACanvas:TCanvas; APoint:TPoint); override; //在acanvas上移动
function MouseInPicRegion(ACanvas:TCanvas;APoint:TPoint): MOUSE_POS; override; //鼠标位置
function CreatePicRgn(ACanvas:TCanvas): HRGN; override; //产生图元区域的句柄
procedure DrawFocusRect(ACanvas:TCanvas); override; //在Acanvas上画焦点
//鼠标响应
procedure ParentMouseDown(ACanvas:TCanvas;CursorNum:Integer; Button: TMouseButton;Shift: TShiftState; APoint:TPoint); override;
procedure ParentMouseMove(ACanvas:TCanvas;CursorNum:Integer; Shift: TShiftState;APoint:TPoint); override;
procedure ParentMouseUp(ACanvas:TCanvas;CursorNum:Integer; Button: TMouseButton; Shift: TShiftState; APoint:TPoint); override;
//键盘响应
procedure ParentKeyDown(ACanvas:TCanvas;CursorNum:Integer; var Key: Word; mouse: TPoint; Shift:TShiftState); override;
procedure ParentKeyUp(ACanvas:TCanvas;CursorNum:Integer; var Key: Word; mouse: TPoint; Shift: TShiftState); override;
//图象改变
procedure PicChangeing(ACanvas:TCanvas; mouseInPos: MOUSE_POS; chooseRect:TRect;
mouseDownOldX, mouseDownOldY, mouseOldX, mouseOldY, mouseX, mouseY:Integer); override;
procedure PicChangedUpdate(ACanvas:TCanvas; mouseInPos: MOUSE_POS;chooseRect: TRect; //选择图元形成的矩形
mouseDownOldX, mouseDownOldY: Integer; mouseX, mouseY: Integer); override; //鼠标当前的坐标
//位置代码可参见 PicConst.pas
procedure AssignPic(SourcePic: TPicBase); override;
//保存和读取数据
procedure GetClassDataFromChar(var Len:Integer; var Buf:Array of Char); override;
procedure SaveClassDataToChar(var Len:Integer; var Buf:Array of Char); override;
//非重载函数
//绘图函数
procedure DrawTextPic(ACanvas: TCanvas; startPoint:TPoint; endPoint:TPoint);
procedure ParentDbClick(ACanvas:TCanvas);
//property 的实现方法
published
property PicStartPoint:TPoint read StartPos write StartPos;
property PicEndPoint: TPoint read EndPos write EndPos;
property Text : TTextInfo Read fText Write SetTextPicText;
property Hollow : Boolean read fHollow write fHollow default False;
property View3D : Boolean read fView3D write fView3D default False;
property Sided : boolean read fSided write fSided default False;
property BkColor: TColor read fBkColor write fBkColor default clBlack;
property TextBmp: TBitMap read fTextbmp Write fTextbmp;
property Canvas: TCanvas read fCanvas;
property EditParent:TObject read feditParent;
property InputMode :Boolean read fInputMode;
property EditMode: Boolean read fEditMode;
property EditShowing:Boolean read GetEditShowing;
property EditText: String read GetEditText;
property Edit:TEdit read fEdit Write fEdit;
property DevTypeID:integer read fDevTypeID Write fDevTypeID;
property PicPen;
property PicBrush;
Property PicFont;
property PicRect;
property Choosed;
property PicId;
property FocusPen;
property FocusBrush;
property PicIndex;
end;
procedure EditTextChange(Sender1:TObject; Sender:TObject);
procedure EditTextKeyDown(Sender1:TObject;Sender: TObject; var Key: Word;Shift: TShiftState);
implementation
uses main,DataMoudle,CHILDWIN;
//--------------------------------------------------------------------------
// wang 2006-01-04 当TEdit.Text的内容变化时，驱动该函数，用来设置TEdit的宽度
//以适应字符串的大小。
//--------------------------------------------------------------------------
procedure EditTextChange(Sender1:TObject; Sender:TObject);
begin
TEdit(Sender).Width :=GetCanvasTextWidth(TEdit(Sender).Text+' ',TEdit(Sender).Font,True);
end;
//--------------------------------------------------------------------------
// wang 2006-01-10 根据是回车还是ESC键（处于非编辑状态）按下确定是绘制文字还是取消绘制。
//--------------------------------------------------------------------------
procedure EditTextKeyDown(Sender1:TObject;Sender: TObject; var Key: Word;Shift: TShiftState);
var //因为TMethod有两个字段，所以这里需要传递两个参数Sender1、Sender;只能这么用，具体原因
aTextInfo:TTextinfo; //有待查证。
begin
aTextInfo.Keyval:=Key;
if key=13 then begin //回车键
TEdit(Sender).Parent:=Nil; //运行时创建的新控件，需指定其父控件， 如果父控件是本地窗口，则可以指定为Nil。
aTextInfo.Text:=TEdit(Sender).Text;
TTextPic(TEdit(Sender).Owner).Text:=aTextInfo; //‘owner’Indicates the component that is responsible for streaming and freeing this component。
end else if key=27 then begin //ESC键
TEdit(Sender).Parent:=Nil;
if not TTextPic(TEdit(Sender).Owner).EditMode then begin //EditMode只有在修改时才为Ture.
aTextInfo.Text:='';
TTextPic(TEdit(Sender).Owner).Text:=aTextInfo;
end;
end;
end;
//--------------------------------------------------------------------------
// wang 2006-01-10 构造函数，使键盘事件和编辑框变化事件与函数对应联系，给文字
//的特殊属性赋初值，创建动态输入框，并设置输入框属性；设置输入或编辑状态为False。
//--------------------------------------------------------------------------
constructor TTextPic.Create(aEditParent:TObject);
var
method:TMethod;
begin
inherited Create;
fText.Text:=''; //文字内容
fHollow:=False; //空心
fSided:=False; //轮廓
// fDevTypeID:=10;
fView3D:=False; //3D效果
fBkColor:=clBlack; //背景颜色
fEdit:=TEdit.Create(Self); //动态创建输入框
fEdit.BorderStyle:=bsNone; //没有边界框
fEdit.Font:=PicFont;
fEdit.Ctl3D:=False; //非3D显示 fEdit.Parent:=MDIChild.ActiveMDIChild;
fEdit.Width:=Abs(PicFont.Height);//TFont只有Height，所以不用width
fEdit.Color:=clBlack;
fEdit.Parent:=nil;
fCanvas:=nil;
Method.Code:=@EditTextChange; //将函数与编辑框大小变化事件进行联系：关键点
Method.Data:=@EditTextChange;
fEdit.OnChange:=TNotifyEvent(Method);
method.Code:=@EditTextKeyDown; //将函数与键盘事件进行联系：关键点
method.Data:=@EditTextKeyDown;
fEdit.OnKeyDown:=TKeyEvent(method);
fTextbmp:=TBitMap.Create; //图象
fTextbmp.PixelFormat:=pf4Bit; //16色位图
fEditParent:=aEditParent;
fInputMode:=False;
fEditMode:=False;
end;
//--------------------------------------------------------------------------
// wang 2006-01-10 析构函数，释放分配的系统资源。
//--------------------------------------------------------------------------
destructor TTextPic.Destroy;
begin
fEditParent:=nil;
fEdit.Free;
fTextbmp.Free;
fCanvas:=Nil;
inherited Destroy;
end;
//--------------------------------------------------------------------------
// wang 2006-01-10 如果fCanvas<>nil则擦除原来的图元，然后，若Keyval为13，则绘制
//新图元，计算新图元的焦点矩形，保存新图元，若Keyval为27，则重绘文字图元（fEditMode＝True）
//并置 fEdit.Text:=''。
//--------------------------------------------------------------------------
procedure TTextPic.SetTextPicText(V:TTextinfo);
begin
fEdit.Parent:=Nil;
if fCanvas<>nil then InvalidatePicRect(fCanvas,PicRect); //擦除image上的图元区域。
Case V.Keyval of
13: begin //回车键
//if fText.Text<>V.Text then begin
fText.Text:=V.Text;
fInputMode:=False;
fEditMode:=False;
if (fText.Text='') then fText.Text:=' ';
Endpos.X:=StartPos.X+GetCanvasTextWidth(fText.Text,PicFont,True);
endPos.Y:=StartPos.Y+GetCanvasTextWidth(fText.Text,PicFont,False); //fEdit.Height;
SetTextPicRect(StartPos,endPos);
Choosed:=True;
DrawTextPic(fCanvas,StartPos,EndPos);
if Assigned(DrawEndEvent) then DrawEndEvent(Self);
//end;
end;
27: begin //ESC键
if fEditMode then DrawTextPic(fCanvas,StartPos,EndPos);
end;
end;
fEdit.Text:='';
end;
//--------------------------------------------------------------------------
// wang 2006-01-10 计算图元矩形的焦点。
//--------------------------------------------------------------------------
procedure TTextPic.GetFocusPoints;
begin
focusPoint[1] := startPos; //左上
focusPoint[2] := Point((StartPos.X+ endPos.X)div 2, StartPos.Y); //上中
focusPoint[3] := Point(EndPos.X,StartPos.Y); //右上
focusPoint[4] := Point(StartPos.X,(StartPos.Y+ endPos.Y)div 2); //左中
focusPoint[5] := Point(EndPos.X,(StartPos.Y+ endPos.Y)div 2); //右中
focusPoint[6] := Point(StartPos.X,EndPos.Y); //左下
focusPoint[7] := Point((StartPos.X + endPos.X)div 2, EndPos.Y); //下中
focusPoint[8] := endPos; //终点
end;
//--------------------------------------------------------------------------
// wang 2006-01-10 将位图绘制在ACanvas上。
//--------------------------------------------------------------------------
procedure TTextPic.DrawBitmapToCanvas(ACanvas:TCanvas;DRect:TRect);
var
i,j:Integer;
x,y:integer;
begin
x:=DRect.Left;
y:=Drect.Top;
For i:=0 to fTextbmp.Width-1 do begin
for j:=0 to fTextbmp.Height-1 do begin
if fTextBmp.Canvas.Pixels[i,j]<>clBlack then begin
ACanvas.Pixels[x+i,y+j]:=fTextbmp.Canvas.Pixels[i,j];
end;
end;
end;
if Choosed then DrawFocusRect(ACanvas);
end;
//--------------------------------------------------------------------------
//wang 2006-1-4 得到TEdit的文字内容。
//--------------------------------------------------------------------------
function TTextPic.GetEditText:String;
begin
Result:=fEdit.Text;
end;
//--------------------------------------------------------------------------
//wang 2006-1-10 设置文字图元焦点矩形的坐标。
//--------------------------------------------------------------------------
procedure TTextPic.SetTextPicRect(StartPoint,EndPoint:TPoint);
var
tmpRect:TRect;
pp: array[1..2] of TPoint;
begin
pp[1] := StartPoint;
pp[2] := EndPoint;
DpToLp(fCanvas.Handle, pp[1], 2);
startPos := pp[1];
endPos := pp[2];
tmpRect.Left := Min(startPos.x, endPos.x);
tmpRect.Top := Min(startPos.y, endPos.y);
tmpRect.Right := Max(startPos.x, endPos.x);
tmpRect.Bottom := Max(startPos.y, endPos.y);
if tmpRect.Left =tmpRect.Right then Inc(tmpRect.Right);
if tmpRect.Top =tmpRect.Bottom then Inc(tmpRect.Bottom);
StartPos:=tmprect.TopLeft;
endpos:=tmprect.BottomRight;
PicRect:=tmpRect;
end;
//--------------------------------------------------------------------------
// wang 2006-01-07 如果是在输入或者编辑状态，则返回结果为True，否则为False。
//--------------------------------------------------------------------------
function TTextPic.GetEditShowing:Boolean;
begin
if (fInputMode or fEditMode) then
Result:=True
else Result:=False;
end;
//--------------------------------------------------------------------------
// wang 2006-01-10 在acanvas上画图元。
//--------------------------------------------------------------------------
procedure TTextPic.DrawPic(ACanvas:TCanvas);
var
pp: array[1..2] of TPoint;
drawStartPoint: Tpoint;
drawEndPoint: Tpoint;
begin
drawStartPoint := startPos;
drawEndPoint := endPos;
pp[1] := drawStartPoint;
pp[2] := drawEndPoint;
LpToDp(ACanvas.Handle, pp[1], 2); //取得设备坐标
drawStartPoint := pp[1];
drawEndPoint:=pp[2];
fCanvas:=ACanvas;
fCanvas.Pen:=PicPen;
fCanvas.Brush:=PicBrush;
fCanvas.Font:=PicFont;
try //一次界面,更新一次遥测。
DrawTextPic(ACanvas, drawStartPoint, drawEndPoint); //2006/06/06改Acanvas为fcanvas
except
on Eoverflow do Application.MessageBox('错误的文件类型，无法读区文件数据！','错误',0);
else
Application.MessageBox('错误的文件类型，无法读区文件数据！','错误',0);
end;
// DrawTextPic(ACanvas, drawStartPoint, drawEndPoint);
if Choosed then DrawFocusRect(fCanvas); //2006/06/06改Acanvas为fcanvas
end;
//--------------------------------------------------------------------------
// wang 2006-01-10 在Acanvas上画焦点。
//--------------------------------------------------------------------------
procedure TTextPic.DrawFocusRect(ACanvas:TCanvas); //
var
mRect: TRect;
FocusNumber: Integer; //焦点数量
i: Integer;
begin
focusNumber := FOCUS_NUM; //=8 焦点数量
GetFocusPoints; //取焦点坐标
LpToDp(ACanvas.Handle,FocusPoint[1],FocusNumber);
ACanvas.Pen:=FocusPen;
ACanvas.Brush:=FocusBrush;
for i := 1 to focusNumber do begin //绘制焦点矩形
mRect.Left := focusPoint.x - FOCUS_SIZE;
mRect.Top := focusPoint.y - FOCUS_SIZE;
mRect.Right := focusPoint.x + FOCUS_SIZE;
mRect.Bottom := focusPoint.y + FOCUS_SIZE;
ACanvas.Rectangle(mRect.Left, mRect.Top, mRect.Right, mRect.Bottom);
end;
end;
//--------------------------------------------------------------------------
// wang 2006-01-02 更新编辑框的位置和大小、字体选择方式、包含编辑框的父控件、
//修改模式、并使其获得输入焦点。
//--------------------------------------------------------------------------
// wang 2006-01-10 鼠标响应，设定输入框的初始属性，父控件、光标位置并获得焦点。
//--------------------------------------------------------------------------
procedure TTextPic.ParentMouseDown(ACanvas:TCanvas;CursorNum:Integer; Button: TMouseButton;Shift: TShiftState; APoint:TPoint);
var Child: TMDIChild;
begin
if Button = mbRight then Exit;
fCanvas:=aCanvas;
StartPos:=APoint; //设置图元的起点
EndPos := APoint; //置终点坐标
fInputMode:=True;
Tform(child):=MainForm.ActiveMDIChild;
fEdit.Left:=APoint.X-child.ScrollBox1.HorzScrollBar.Position;
FEdit.Top :=APoint.Y-child.ScrollBox1.VertScrollBar.Position;
fEdit.Height:=Abs(PicFont.Height)+2;
fEdit.Font:=PicFont;
fEdit.Parent:= TWinControl(fEditParent); //设定输入框的父控件
fEdit.AutoSelect:=False;
fEdit.SelStart:=Length(fEdit.Text);
fEdit.SetFocus; //使编辑框获得输入焦点
end;
//--------------------------------------------------------------------------
// wang 2006-01-10 绘制图元的函数。
//--------------------------------------------------------------------------
procedure TTextPic.DrawTextPic(ACanvas: TCanvas; startPoint:TPoint; endPoint:TPoint);
var TID,DID,PID:integer;
SQL_Clause:string;
// TempBmp:TBitMap;
begin
ACanvas.Lock;
fTextbmp.Canvas.Lock;
if fText.Text='' then Exit;
fTextbmp.Width:=EndPoint.X-StartPoint.X+1;
fTextBmp.Height:=EndPoint.Y-StartPoint.Y+1;
//清除原来画面的内容
FTextbmp.Canvas.Brush.Color:=clBlack;
fTextBmp.Canvas.Brush.Style:=bsSolid;
fTextbmp.Canvas.FillRect(Rect(0,0,fTextbmp.Width,fTextbmp.Height));
//重新画图
FTextbmp.Canvas.Brush.Color:=PicBrush.Color;
fTextBmp.Canvas.Brush.Style:=PicBrush.Style;
fTextbmp.Canvas.FillRect(Rect(0,0,fTextbmp.Width,fTextbmp.Height));
FtextBmp.Canvas.Font:=PicFont;
ftextbmp.Canvas.Pen:=PicPen;
fTextbmp.Canvas.Brush:=PicBrush;
fTextbmp.Canvas.Brush.Style:=bsClear;
fTextbmp.Canvas.TextOut(1,1,fText.Text); //在Canvas上写字，并将光标移动到字符串的末端。
if fHollow then FreeFontInSide(fTextbmp); //空心，wang，擦除内部字体
if fSided then LineFontOutSide(fTextbmp); //边框
if fView3D then View3dFont(fTextbmp); //3D效果
DrawBitmapToCanvas(ACanvas,Rect(StartPoint,endPoint));
PicId:=PIC_TEXT;
fTextbmp.Canvas.Unlock;
ACanvas.Unlock;
end;
unit TextPic;
interface
uses Windows,Graphics,Math,Classes,Controls,StdCtrls,ExtCtrls,Messages,SysUtils,
PicConst,PicBase,PicFuns, BmpFuns, Variants,Forms,Dialogs;
const
FOCUS_NUM=8;
type
TTextPic=Class(TPicBase)
private
StartPos:TPoint;
EndPos:TPoint;
fText:TTextInfo; //String; //wang 2006-1-4 文字内容，自定义的记录类型。
fHollow: Boolean; //空心
fSided: Boolean; //轮廓
fView3D: Boolean; //3D效果
fBkColor: TColor; //背景颜色
//
oldsp,oldep:TPoint;
FocusPoint:Array[1..FOCUS_NUM] of TPoint;
fEdit: TEdit; //输入框
fTextbmp: TBitMap; //图象
fCanvas:TCanvas;
fInputMode:Boolean; //图象文字输入状态
fEditMode: Boolean; //修改模式
fEditParent: TObject; //fEdit的parent;
procedure GetFocusPoints;
procedure DrawBitmapToCanvas(aCanvas:TCanvas;DRect:TRect);
procedure SetTextPicText(V:TTextInfo);
procedure SetTextPicRect(StartPoint,endPoint:TPoint);
function GetEditShowing:Boolean;
function GetEditText:String;
public
fDevTypeID:integer;
DevID,ParaID:integer;
public
constructor Create(aEditParent:TObject);
destructor Destroy; override;
procedure DrawPic(ACanvas:TCanvas); override; //在acanvas上画图
procedure MovePic(ACanvas:TCanvas; APoint:TPoint); override; //在acanvas上移动
function MouseInPicRegion(ACanvas:TCanvas;APoint:TPoint): MOUSE_POS; override; //鼠标位置
function CreatePicRgn(ACanvas:TCanvas): HRGN; override; //产生图元区域的句柄
procedure DrawFocusRect(ACanvas:TCanvas); override; //在Acanvas上画焦点
//鼠标响应
procedure ParentMouseDown(ACanvas:TCanvas;CursorNum:Integer; Button: TMouseButton;Shift: TShiftState; APoint:TPoint); override;
procedure ParentMouseMove(ACanvas:TCanvas;CursorNum:Integer; Shift: TShiftState;APoint:TPoint); override;
procedure ParentMouseUp(ACanvas:TCanvas;CursorNum:Integer; Button: TMouseButton; Shift: TShiftState; APoint:TPoint); override;
//键盘响应
procedure ParentKeyDown(ACanvas:TCanvas;CursorNum:Integer; var Key: Word; mouse: TPoint; Shift:TShiftState); override;
procedure ParentKeyUp(ACanvas:TCanvas;CursorNum:Integer; var Key: Word; mouse: TPoint; Shift: TShiftState); override;
//图象改变
procedure PicChangeing(ACanvas:TCanvas; mouseInPos: MOUSE_POS; chooseRect:TRect;
mouseDownOldX, mouseDownOldY, mouseOldX, mouseOldY, mouseX, mouseY:Integer); override;
procedure PicChangedUpdate(ACanvas:TCanvas; mouseInPos: MOUSE_POS;chooseRect: TRect; //选择图元形成的矩形
mouseDownOldX, mouseDownOldY: Integer; mouseX, mouseY: Integer); override; //鼠标当前的坐标
//位置代码可参见 PicConst.pas
procedure AssignPic(SourcePic: TPicBase); override;
//保存和读取数据
procedure GetClassDataFromChar(var Len:Integer; var Buf:Array of Char); override;
procedure SaveClassDataToChar(var Len:Integer; var Buf:Array of Char); override;
//非重载函数
//绘图函数
procedure DrawTextPic(ACanvas: TCanvas; startPoint:TPoint; endPoint:TPoint);
procedure ParentDbClick(ACanvas:TCanvas);
//property 的实现方法
published
property PicStartPoint:TPoint read StartPos write StartPos;
property PicEndPoint: TPoint read EndPos write EndPos;
property Text : TTextInfo Read fText Write SetTextPicText;
property Hollow : Boolean read fHollow write fHollow default False;
property View3D : Boolean read fView3D write fView3D default False;
property Sided : boolean read fSided write fSided default False;
property BkColor: TColor read fBkColor write fBkColor default clBlack;
property TextBmp: TBitMap read fTextbmp Write fTextbmp;
property Canvas: TCanvas read fCanvas;
property EditParent:TObject read feditParent;
property InputMode :Boolean read fInputMode;
property EditMode: Boolean read fEditMode;
property EditShowing:Boolean read GetEditShowing;
property EditText: String read GetEditText;
property Edit:TEdit read fEdit Write fEdit;
property DevTypeID:integer read fDevTypeID Write fDevTypeID;
property PicPen;
property PicBrush;
Property PicFont;
property PicRect;
property Choosed;
property PicId;
property FocusPen;
property FocusBrush;
property PicIndex;
end;
procedure EditTextChange(Sender1:TObject; Sender:TObject);
procedure EditTextKeyDown(Sender1:TObject;Sender: TObject; var Key: Word;Shift: TShiftState);
implementation
uses main,DataMoudle,CHILDWIN;
//--------------------------------------------------------------------------
// wang 2006-01-04 当TEdit.Text的内容变化时，驱动该函数，用来设置TEdit的宽度
//以适应字符串的大小。
//--------------------------------------------------------------------------
procedure EditTextChange(Sender1:TObject; Sender:TObject);
begin
TEdit(Sender).Width :=GetCanvasTextWidth(TEdit(Sender).Text+' ',TEdit(Sender).Font,True);
end;
//--------------------------------------------------------------------------
// wang 2006-01-10 根据是回车还是ESC键（处于非编辑状态）按下确定是绘制文字还是取消绘制。
//--------------------------------------------------------------------------
procedure EditTextKeyDown(Sender1:TObject;Sender: TObject; var Key: Word;Shift: TShiftState);
var //因为TMethod有两个字段，所以这里需要传递两个参数Sender1、Sender;只能这么用，具体原因
aTextInfo:TTextinfo; //有待查证。
begin
aTextInfo.Keyval:=Key;
if key=13 then begin //回车键
TEdit(Sender).Parent:=Nil; //运行时创建的新控件，需指定其父控件， 如果父控件是本地窗口，则可以指定为Nil。
aTextInfo.Text:=TEdit(Sender).Text;
TTextPic(TEdit(Sender).Owner).Text:=aTextInfo; //‘owner’Indicates the component that is responsible for streaming and freeing this component。
end else if key=27 then begin //ESC键
TEdit(Sender).Parent:=Nil;
if not TTextPic(TEdit(Sender).Owner).EditMode then begin //EditMode只有在修改时才为Ture.
aTextInfo.Text:='';
TTextPic(TEdit(Sender).Owner).Text:=aTextInfo;
end;
end;
end;
//--------------------------------------------------------------------------
// wang 2006-01-10 构造函数，使键盘事件和编辑框变化事件与函数对应联系，给文字
//的特殊属性赋初值，创建动态输入框，并设置输入框属性；设置输入或编辑状态为False。
//--------------------------------------------------------------------------
constructor TTextPic.Create(aEditParent:TObject);
var
method:TMethod;
begin
inherited Create;
fText.Text:=''; //文字内容
fHollow:=False; //空心
fSided:=False; //轮廓
// fDevTypeID:=10;
fView3D:=False; //3D效果
fBkColor:=clBlack; //背景颜色
fEdit:=TEdit.Create(Self); //动态创建输入框
fEdit.BorderStyle:=bsNone; //没有边界框
fEdit.Font:=PicFont;
fEdit.Ctl3D:=False; //非3D显示 fEdit.Parent:=MDIChild.ActiveMDIChild;
fEdit.Width:=Abs(PicFont.Height);//TFont只有Height，所以不用width
fEdit.Color:=clBlack;
fEdit.Parent:=nil;
fCanvas:=nil;
Method.Code:=@EditTextChange; //将函数与编辑框大小变化事件进行联系：关键点
Method.Data:=@EditTextChange;
fEdit.OnChange:=TNotifyEvent(Method);
method.Code:=@EditTextKeyDown; //将函数与键盘事件进行联系：关键点
method.Data:=@EditTextKeyDown;
fEdit.OnKeyDown:=TKeyEvent(method);
fTextbmp:=TBitMap.Create; //图象
fTextbmp.PixelFormat:=pf4Bit; //16色位图
fEditParent:=aEditParent;
fInputMode:=False;
fEditMode:=False;
end;
//--------------------------------------------------------------------------
// wang 2006-01-10 析构函数，释放分配的系统资源。
//--------------------------------------------------------------------------
destructor TTextPic.Destroy;
begin
fEditParent:=nil;
fEdit.Free;
fTextbmp.Free;
fCanvas:=Nil;
inherited Destroy;
end;
//--------------------------------------------------------------------------
// wang 2006-01-10 如果fCanvas<>nil则擦除原来的图元，然后，若Keyval为13，则绘制
//新图元，计算新图元的焦点矩形，保存新图元，若Keyval为27，则重绘文字图元（fEditMode＝True）
//并置 fEdit.Text:=''。
//--------------------------------------------------------------------------
procedure TTextPic.SetTextPicText(V:TTextinfo);
begin
fEdit.Parent:=Nil;
if fCanvas<>nil then InvalidatePicRect(fCanvas,PicRect); //擦除image上的图元区域。
Case V.Keyval of
13: begin //回车键
//if fText.Text<>V.Text then begin
fText.Text:=V.Text;
fInputMode:=False;
fEditMode:=False;
if (fText.Text='') then fText.Text:=' ';
Endpos.X:=StartPos.X+GetCanvasTextWidth(fText.Text,PicFont,True);
endPos.Y:=StartPos.Y+GetCanvasTextWidth(fText.Text,PicFont,False); //fEdit.Height;
SetTextPicRect(StartPos,endPos);
Choosed:=True;
DrawTextPic(fCanvas,StartPos,EndPos);
if Assigned(DrawEndEvent) then DrawEndEvent(Self);
//end;
end;
27: begin //ESC键
if fEditMode then DrawTextPic(fCanvas,StartPos,EndPos);
end;
end;
fEdit.Text:='';
end;
//--------------------------------------------------------------------------
// wang 2006-01-10 计算图元矩形的焦点。
//--------------------------------------------------------------------------
procedure TTextPic.GetFocusPoints;
begin
focusPoint[1] := startPos; //左上
focusPoint[2] := Point((StartPos.X+ endPos.X)div 2, StartPos.Y); //上中
focusPoint[3] := Point(EndPos.X,StartPos.Y); //右上
focusPoint[4] := Point(StartPos.X,(StartPos.Y+ endPos.Y)div 2); //左中
focusPoint[5] := Point(EndPos.X,(StartPos.Y+ endPos.Y)div 2); //右中
focusPoint[6] := Point(StartPos.X,EndPos.Y); //左下
focusPoint[7] := Point((StartPos.X + endPos.X)div 2, EndPos.Y); //下中
focusPoint[8] := endPos; //终点
end;
//--------------------------------------------------------------------------
// wang 2006-01-10 将位图绘制在ACanvas上。
//--------------------------------------------------------------------------
procedure TTextPic.DrawBitmapToCanvas(ACanvas:TCanvas;DRect:TRect);
var
i,j:Integer;
x,y:integer;
begin
x:=DRect.Left;
y:=Drect.Top;
For i:=0 to fTextbmp.Width-1 do begin
for j:=0 to fTextbmp.Height-1 do begin
if fTextBmp.Canvas.Pixels[i,j]<>clBlack then begin
ACanvas.Pixels[x+i,y+j]:=fTextbmp.Canvas.Pixels[i,j];
end;
end;
end;
if Choosed then DrawFocusRect(ACanvas);
end;
//--------------------------------------------------------------------------
//wang 2006-1-4 得到TEdit的文字内容。
//--------------------------------------------------------------------------
function TTextPic.GetEditText:String;
begin
Result:=fEdit.Text;
end;
//--------------------------------------------------------------------------
//wang 2006-1-10 设置文字图元焦点矩形的坐标。
//--------------------------------------------------------------------------
procedure TTextPic.SetTextPicRect(StartPoint,EndPoint:TPoint);
var
tmpRect:TRect;
pp: array[1..2] of TPoint;
begin
pp[1] := StartPoint;
pp[2] := EndPoint;
DpToLp(fCanvas.Handle, pp[1], 2);
startPos := pp[1];
endPos := pp[2];
tmpRect.Left := Min(startPos.x, endPos.x);
tmpRect.Top := Min(startPos.y, endPos.y);
tmpRect.Right := Max(startPos.x, endPos.x);
tmpRect.Bottom := Max(startPos.y, endPos.y);
if tmpRect.Left =tmpRect.Right then Inc(tmpRect.Right);
if tmpRect.Top =tmpRect.Bottom then Inc(tmpRect.Bottom);
StartPos:=tmprect.TopLeft;
endpos:=tmprect.BottomRight;
PicRect:=tmpRect;
end;
//--------------------------------------------------------------------------
// wang 2006-01-07 如果是在输入或者编辑状态，则返回结果为True，否则为False。
//--------------------------------------------------------------------------
function TTextPic.GetEditShowing:Boolean;
begin
if (fInputMode or fEditMode) then
Result:=True
else Result:=False;
end;
//--------------------------------------------------------------------------
// wang 2006-01-10 在acanvas上画图元。
//--------------------------------------------------------------------------
procedure TTextPic.DrawPic(ACanvas:TCanvas);
var
pp: array[1..2] of TPoint;
drawStartPoint: Tpoint;
drawEndPoint: Tpoint;
begin
drawStartPoint := startPos;
drawEndPoint := endPos;
pp[1] := drawStartPoint;
pp[2] := drawEndPoint;
LpToDp(ACanvas.Handle, pp[1], 2); //取得设备坐标
drawStartPoint := pp[1];
drawEndPoint:=pp[2];
fCanvas:=ACanvas;
fCanvas.Pen:=PicPen;
fCanvas.Brush:=PicBrush;
fCanvas.Font:=PicFont;
try //一次界面,更新一次遥测。
DrawTextPic(ACanvas, drawStartPoint, drawEndPoint); //2006/06/06改Acanvas为fcanvas
except
on Eoverflow do Application.MessageBox('错误的文件类型，无法读区文件数据！','错误',0);
else
Application.MessageBox('错误的文件类型，无法读区文件数据！','错误',0);
end;
// DrawTextPic(ACanvas, drawStartPoint, drawEndPoint);
if Choosed then DrawFocusRect(fCanvas); //2006/06/06改Acanvas为fcanvas
end;
//--------------------------------------------------------------------------
// wang 2006-01-10 在Acanvas上画焦点。
//--------------------------------------------------------------------------
procedure TTextPic.DrawFocusRect(ACanvas:TCanvas); //
var
mRect: TRect;
FocusNumber: Integer; //焦点数量
i: Integer;
begin
focusNumber := FOCUS_NUM; //=8 焦点数量
GetFocusPoints; //取焦点坐标
LpToDp(ACanvas.Handle,FocusPoint[1],FocusNumber);
ACanvas.Pen:=FocusPen;
ACanvas.Brush:=FocusBrush;
for i := 1 to focusNumber do begin //绘制焦点矩形
mRect.Left := focusPoint.x - FOCUS_SIZE;
mRect.Top := focusPoint.y - FOCUS_SIZE;
mRect.Right := focusPoint.x + FOCUS_SIZE;
mRect.Bottom := focusPoint.y + FOCUS_SIZE;
ACanvas.Rectangle(mRect.Left, mRect.Top, mRect.Right, mRect.Bottom);
end;
end;
//--------------------------------------------------------------------------
// wang 2006-01-02 更新编辑框的位置和大小、字体选择方式、包含编辑框的父控件、
//修改模式、并使其获得输入焦点。
//--------------------------------------------------------------------------
// wang 2006-01-10 鼠标响应，设定输入框的初始属性，父控件、光标位置并获得焦点。
//--------------------------------------------------------------------------
procedure TTextPic.ParentMouseDown(ACanvas:TCanvas;CursorNum:Integer; Button: TMouseButton;Shift: TShiftState; APoint:TPoint);
var Child: TMDIChild;
begin
if Button = mbRight then Exit;
fCanvas:=aCanvas;
StartPos:=APoint; //设置图元的起点
EndPos := APoint; //置终点坐标
fInputMode:=True;
Tform(child):=MainForm.ActiveMDIChild;
fEdit.Left:=APoint.X-child.ScrollBox1.HorzScrollBar.Position;
FEdit.Top :=APoint.Y-child.ScrollBox1.VertScrollBar.Position;
fEdit.Height:=Abs(PicFont.Height)+2;
fEdit.Font:=PicFont;
fEdit.Parent:= TWinControl(fEditParent); //设定输入框的父控件
fEdit.AutoSelect:=False;
fEdit.SelStart:=Length(fEdit.Text);
fEdit.SetFocus; //使编辑框获得输入焦点
end;
//--------------------------------------------------------------------------
// wang 2006-01-10 绘制图元的函数。
//--------------------------------------------------------------------------
procedure TTextPic.DrawTextPic(ACanvas: TCanvas; startPoint:TPoint; endPoint:TPoint);
var TID,DID,PID:integer;
SQL_Clause:string;
// TempBmp:TBitMap;
begin
ACanvas.Lock;
fTextbmp.Canvas.Lock;
if fText.Text='' then Exit;
fTextbmp.Width:=EndPoint.X-StartPoint.X+1;
fTextBmp.Height:=EndPoint.Y-StartPoint.Y+1;
//清除原来画面的内容
FTextbmp.Canvas.Brush.Color:=clBlack;
fTextBmp.Canvas.Brush.Style:=bsSolid;
fTextbmp.Canvas.FillRect(Rect(0,0,fTextbmp.Width,fTextbmp.Height));
//重新画图
FTextbmp.Canvas.Brush.Color:=PicBrush.Color;
fTextBmp.Canvas.Brush.Style:=PicBrush.Style;
fTextbmp.Canvas.FillRect(Rect(0,0,fTextbmp.Width,fTextbmp.Height));
FtextBmp.Canvas.Font:=PicFont;
ftextbmp.Canvas.Pen:=PicPen;
fTextbmp.Canvas.Brush:=PicBrush;
fTextbmp.Canvas.Brush.Style:=bsClear;
fTextbmp.Canvas.TextOut(1,1,fText.Text); //在Canvas上写字，并将光标移动到字符串的末端。
if fHollow then FreeFontInSide(fTextbmp); //空心，wang，擦除内部字体
if fSided then LineFontOutSide(fTextbmp); //边框
if fView3D then View3dFont(fTextbmp); //3D效果
DrawBitmapToCanvas(ACanvas,Rect(StartPoint,endPoint));
PicId:=PIC_TEXT;
fTextbmp.Canvas.Unlock;
ACanvas.Unlock;
end;