📄 freepicu.pas
字号:
mLinePic:=TLinePic.Create;
mLinePic.AssignPic(CopyPic);
mLinePic.DrawPic(Image1.Canvas);
mLinePic.MovePic(Image1.Canvas,Point(PICDIFF,PICDIFF));
mLinePic.PicIndex:=PicList.Count;
mLinePic.Choosed:=True;
PicList.Add(mLinePic);
end;
PIC_RECT:
begin
mRectPic:=TRectPic.Create;
mRectPic.AssignPic(CopyPic);
mRectPic.DrawPic(Image1.Canvas);
mRectPic.MovePic(Image1.Canvas,Point(PICDIFF,PICDIFF));
mRectPic.PicIndex:=PicList.Count;
mRectPic.Choosed:=True;
PicList.Add(mRectPic);
end;
PIC_ROUN:
begin
mRounPic:=TRounPic.Create;
mRounPic.AssignPic(CopyPic);
mRounPic.DrawPic(Image1.Canvas);
mRounPic.MovePic(Image1.Canvas,Point(PICDIFF,PICDIFF));
mRounPic.PicIndex:=PicList.Count;
mRounPic.Choosed:=True;
PicList.Add(mRounPic);
end;
PIC_CIRC:
begin
mCircPic:=TCircPic.Create;
mCircPic.AssignPic(CopyPic);
mCircPic.DrawPic(Image1.Canvas);
mCircPic.MovePic(Image1.Canvas,Point(PICDIFF,PICDIFF));
mCircPic.PicIndex:=PicList.Count;
mCircPic.Choosed:=True;
PicList.Add(mCircPic);
end;
PIC_ARCC:
begin
mArccPic:=TArccPic.Create;
mArccPic.AssignPic(CopyPic);
mArccPic.DrawPic(Image1.Canvas);
mArccPic.MovePic(Image1.Canvas,Point(PICDIFF,PICDIFF));
mArccPic.PicIndex:=PicList.Count;
mArccPic.Choosed:=True;
PicList.Add(mArccPic);
end;
PIC_POLY:
begin
mPolyPic:=TPolyPic.Create;
mPolyPic.AssignPic(CopyPic);
mPolyPic.DrawPic(Image1.Canvas);
mPolyPic.MovePic(Image1.Canvas,Point(PICDIFF,PICDIFF));
mPolyPic.PicIndex:=PicList.Count;
mPolyPic.Choosed:=True;
PicList.Add(mPolyPic);
end;
PIC_CURVE:
begin
mCurvePic:=TCurvePic.Create;
mCurvePic.AssignPic(CopyPic);
mCurvePic.DrawPic(Image1.Canvas);
mCurvePic.MovePic(Image1.Canvas,Point(PICDIFF,PICDIFF));
mCurvePic.PicIndex:=PicList.Count;
mCurvePic.Choosed:=True;
PicList.Add(mCurvePic);
end;
PIC_TEXT:
begin
mTextPic:=TTextPic.Create(Nil);
mTextPic.AssignPic(CopyPic);
mTextPic.DrawPic(Image1.Canvas);
mTextPic.MovePic(Image1.Canvas,Point(PICDIFF,PICDIFF));
mTextPic.PicIndex:=PicList.Count;
mTextPic.Choosed:=True;
PicList.Add(mTextPic);
end;
end;
SelPic:=TPicBase(PicList.Items[PicList.Count-1]);
CopyPic:=SelPic;
GetImageCanvasBmp(False,True);
end;
end;
4: begin
if SelPic<>Nil then begin
if SelPic.PicIndex<0 then Exit;
if MessageDlg('您确实要删除该图元么？',mtConfirmation,[mbYes,mbNo],0)=mrYes then begin
mIndex:=SelPic.PicIndex;
Case TPicBase(PicList.Items[mIndex]).PicId of
PIC_LINE: TLinePic(PicList.Items[mIndex]).Free;
PIC_RECT: TRectPic(PicList.Items[mIndex]).Free;
PIC_ROUN: TRounPic(PicList.Items[mIndex]).Free;
PIC_CIRC: TCircPic(PicList.Items[mIndex]).Free;
PIC_ARCC: TArccPic(PicList.Items[mIndex]).Free;
PIC_POLY: TPolyPic(PicList.Items[mIndex]).Free;
PIC_CURVE: TCurvePic(PicList.Items[mIndex]).Free;
PIC_TEXT: TTextPic(PicList.Items[mIndex]).Free;
end;
ChangPicListItemIndex;
SelPic:=nil;
end;
end;
end;
end;
end;
procedure TFreePicF.N16Click(Sender: TObject);
begin
Case TMenuItem(Sender).Tag of
1: SpeedButton4Click(SpeedButton4);
2: SpeedButton4Click(SpeedButton5);
3: SpeedButton4Click(SpeedButton6);
4: SpeedButton4Click(SpeedButton7);
end;
end;
procedure TFreePicF.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
Case Key of
46: SpeedButton4Click(SpeedButton7);
38: if SelPic<>Nil then SelPic.MovePic(Image1.Canvas,Point(0,-1));
40: if SelPic<>Nil then SelPic.MovePic(Image1.Canvas,Point(0,1));
37: if SelPic<>Nil then SelPic.MovePic(Image1.Canvas,Point(-1,0));
39: if SelPic<>Nil then SelPic.MovePic(Image1.Canvas,Point(1,0));
67: if (ssCtrl in Shift) then SpeedButton4Click(SpeedButton4);
86: if (ssCtrl in Shift) then SpeedButton4Click(SpeedButton6);
end;
if ((Key>=37)and(Key<=40)) then GetImageCanvasBmp(False,True);
end;
procedure TFreePicF.Image1DblClick(Sender: TObject);
begin
if (SelPic is TTextPic) then begin
if Image1.Cursor<>CURSOR_ARROW then begin
TTextPic(SelPic).ParentDbClick(Image1.Canvas); //问题
Image1.Tag:=1; //使用Image1的TAG作为修改文字的标识
end;
end;
end;
procedure TFreePicf.ClearPicListData;
var
i1:Integer;
SpeedButton:TComponent;
begin
For i1:=PicList.Count-1 downto 0 do begin
Case TPicBase(PicList.Items[i1]).PicId of
PIC_LINE: TLinePic(PicList.Items[i1]).Free;
PIC_RECT: TRectPic(PicList.Items[i1]).Free;
PIC_ROUN: TRounPic(PicList.Items[i1]).Free;
PIC_CIRC: TCircPic(PicList.Items[i1]).Free;
PIC_ARCC: TArccPic(PicList.Items[i1]).Free;
PIC_POLY: TPolyPic(PicList.Items[i1]).Free;
PIC_CURVE: TCurvePic(PicList.Items[i1]).Free;
PIC_TEXT: TTextPic(PicList.Items[i1]).Free;
end;
end;
For i1:=8 to 18 do begin
SpeedButton:=FindComponent('SpeedButton'+IntToStr(i1));
TSpeedButton(SpeedButton).Down:=False;
end;
end;
procedure TFreePicF.SpeedButton1Click(Sender: TObject);
begin
if PicList.Count>0 then begin
if MessageDlg('当前图象内容已改变，是否保存？',mtConfirmation,[mbYes,mbNo],0)=mrYes then begin
SpeedButton3Click(Nil);
end;
end;
ClearPicListData;
SelPic:=nil; //没有选择
Image1.Cursor:=CURSOR_ARROW;
GetImageCanvasBmp(False,True);
end;
procedure TFreePicF.SpeedButton3Click(Sender: TObject);
var
I1:Integer;
tf:File;
fn:String;
mPicType:TPicType;
procedure SetInfBufData(pictype:TPicType;PicLen:Integer);
var
P:Pointer;
begin
P:=Pointer(@InfBuf[0]);
PByte(P)^:=Ord(PicType);
Inc(PByte(P));
PInteger(P)^:=PicLen;
Inc(PInteger(P));
end;
procedure SetPicCountInfData(V:integer);
var
P:Pointer;
begin
P:=Pointer(@InfBuf[0]);
PInteger(P)^:=V;
end;
begin
SaveDialog1.InitialDir:=ExtractFilePath(Paramstr(0))+'Bmps\';
if SaveDialog1.Execute then begin
try
//保存图象
GetImageCanvasBmp(True,False);
OffSrc.SaveToFile(SaveDialog1.FileName);
//保存图元列表
fn:=ChangeFileExt(SaveDialog1.FileName,'.fdf');
AssignFile(tf,fn);
ReWrite(tf,1);
//写文件头信息
PicBuf:='This File Structure Is Designed By WangChangYu! 2004-06-22';
PicBuf[59]:=#18;
BlockWrite(tf,PicBuf,60); //写入文件说明
SetPicCountInfData(PicList.Count);
BlockWrite(tf,InfBuf,4); //写入总图元数
For i1:=0 to PicList.Count-1 do begin
mPicType:=TPicBase(PicList.Items[i1]).PicId;
Case mPicType of
PIC_LINE: TLinePic(PicList.Items[i1]).SaveClassDataToChar(BufLen,PicBuf); //直线
PIC_RECT: TRectPic(PicList.Items[i1]).SaveClassDataToChar(BufLen,PicBuf); //矩形
PIC_ROUN: TRounPic(PicList.Items[i1]).SaveClassDataToChar(BufLen,PicBuf); //圆角矩形
PIC_CIRC: TCircPic(PicList.Items[i1]).SaveClassDataToChar(BufLen,PicBuf); //圆形
PIC_ARCC: TArccPic(PicList.Items[i1]).SaveClassDataToChar(BufLen,PicBuf); //弧类
PIC_POLY: TPolyPic(PicList.Items[i1]).SaveClassDataToChar(BufLen,PicBuf); //多边形
PIC_CURVE:TCurvePic(PicList.Items[i1]).SaveClassDataToChar(BufLen,PicBuf); //曲线
PIC_TEXT: TTextPic(PicList.Items[i1]).SaveClassDataToChar(BufLen,PicBuf); //文本
end;
SetInfBufData(mPicType,BufLen-1);
BlockWrite(tf,InfBuf,SizeOf(InfBuf)); //写入图元信息
BlockWrite(tf,PicBuf,BufLen-1); //写入图元数据
end;
finally
CloseFile(tf);
end;
end;
end;
procedure TFreePicF.SpeedButton2Click(Sender: TObject);
var
I1:integer;
sf:File;
mPicType:TPicType;
PicCount:Integer;
mLinePic:TLinePic;
mRectPic:TRectPic;
mRounPic:TRounPic;
mCircPic:TCircPic;
mArccPic:TArccPic;
mPolyPic:TPolyPic;
mCurvePic:TCurvePic;
mTextPic:TTextPic;
procedure GetPicDataInfoAndLen;
var
p:Pointer;
begin
p:=Pointer(@InfBuf[0]);
mPicType:=TPicType(PByte(P)^);
inc(PByte(P));
BufLen:=PInteger(P)^;
end;
procedure GetPicCountInfoData;
var
p:Pointer;
begin
p:=Pointer(@InfBuf[0]);
PicCount:=PInteger(P)^;
end;
begin
OpenDialog1.InitialDir:=ExtractFilePath(Paramstr(0))+'Bmps\';
if OpenDialog1.Execute then begin
try
SpeedButton1Click(Nil); //清楚原来的内容
AssignFile(sf,OpenDialog1.FileName);
Reset(sf,1);
Seek(sf,59);
BlockRead(sf,InfBuf,1);
if InfBuf[0]=#18 then begin
BlockRead(sf,InfBuf,4);
GetPicCountInfoData;
For i1:=1 to PicCount do begin
BlockRead(sf,InfBuf,5);
GetPicDataInfoAndLen;
BlockRead(sf,PicBuf,BufLen);
Case mPictype of
PIC_LINE:
begin //直线
mLinePic:=TLinePic.Create;
mLinePic.GetClassDataFromChar(BufLen,PicBuf);
PicList.Add(mLinePic);
end;
PIC_RECT: //矩形
begin
mRectPic:=TRectPic.Create;
mRectPic.GetClassDataFromChar(BufLen,PicBuf);
PicList.Add(mRectPic);
end;
PIC_ROUN: //圆角矩形
begin
mRounPic:=TRounPic.Create;
mRounPic.GetClassDataFromChar(BufLen,PicBuf);
PicList.Add(mRounPic);
end;
PIC_CIRC: //圆形
begin
mCircPic:=TCircPic.Create;
mCircPic.GetClassDataFromChar(BufLen,PicBuf);
PicList.Add(mCircPic);
end;
PIC_ARCC: //弧类
begin
mArccPic:=TArccPic.Create;
mArccPic.GetClassDataFromChar(BufLen,PicBuf);
PicList.Add(mArccPic);
end;
PIC_POLY: //多边形
begin
mPolyPic:=TPolyPic.Create;
mPolyPic.GetClassDataFromChar(BufLen,PicBuf);
PicList.Add(mPolyPic);
end;
PIC_CURVE: //曲线
begin
mCurvePic:=TCurvePic.Create;
mCurvePic.GetClassDataFromChar(BufLen,PicBuf);
PicList.Add(mCurvePic);
end;
PIC_TEXT: //文本
begin
mTextPic:=TTextPic.Create(ScrollBox1);
mTextPic.GetClassDataFromChar(BufLen,PicBuf);
PicList.Add(mTextPic);
end;
end;
end;
end else Application.MessageBox('错误的文件类型，无法读区文件数据！','错误',0);
finally
CloseFile(sf);
end;
SelPic:=Nil;
GetImageCanvasBmp(False,True);
end;
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -