procedure TForm1.btn1Click(Sender: TObject);
var
MyCanvas1: TControlCanvas;
bitmap: TBitmap;
MyCanvas2: TControlCanvas;
files: string;
XScale, YScale: Double; //x,y坐标比例
Sero_x, Sero_y: Integer;
s: TStringList;
i: Integer;
x, y, x1, y1: Integer;
strTmp: string;
begin
files := dlgOpen1.FileName;
bitmap := TBitmap.Create;
MyCanvas1 := TControlCanvas.Create;
try
bitmap.LoadFromFile(files);
Mycanvas1.control := img1;
MyCanvas1.StretchDraw(img1.clientRect, bitmap);
XScale := (Abs((StrToInt(edt2.Text)) - (StrToInt(edt1.Text)))) / 100; //x比例
YScale := (Abs((StrToInt(edt4.Text)) - (StrToInt(edt3.Text)))) / 100; //y比例
Sero_x := Abs((StrToInt(edt2.Text)) - (StrToInt(edt1.Text)) - (StrToInt(edt1.Text)));
Sero_y := Abs((StrToInt(edt4.Text)) - (StrToInt(edt3.Text)) - (StrToInt(edt3.Text)));
lbl7.Caption := 'X比例:' + FloatToStr(XScale) + ' ' + 'Y比例:' + FloatToStr(YScale)
+ ' ' + 'X补偿:' + IntToStr(Sero_x) + ' ' + 'Y补偿:' + IntToStr(Sero_y);
for i := 0 to lst1.Count - 1 do
begin
s := split(lst1.Items[i], ',');
x := Trunc((StrToInt(s[0])) * XScale + Sero_x); //转换比例尺
y := Trunc(Sero_y - (StrToInt(s[1])) * YScale);
x1 := x + (StrToInt(edt5.Text) - 21);
y1 := y + (StrToInt(edt6.Text) + 6);
strTmp := s[0] + ',' + s[1];
if chk1.Checked = False then
begin
MyCanvas1.Brush.Style := bsClear;
MyCanvas1.Font.Color := clBlack; //字体颜色
MyCanvas1.Font.Name := 'MS Sans Serif';
MyCanvas1.Font.Style := [fsBold];
MyCanvas1.Textout(x1, y1, strTmp);
MyCanvas1.Brush.Style := bsClear;
end else
begin
MyCanvas1.Font.Color := clBlack; //字体颜色
MyCanvas1.Font.Name := 'MS Sans Serif';
MyCanvas1.Textout(x1, y1, strTmp);
end;
//Sleep(800);
end;
finally
// img1 .Picture.SaveToFile(Extractfilepath(Application.ExeName)+'01.bmp');
bitmap.Free;
MyCanvas1.Free;
end;
windows.Beep(500, 200);
end;图像画好了 请问怎么把画布上的图片保存下来啊 再下是新手 今天找了一天了都没找到办法canvas
var
MyCanvas1: TControlCanvas;
bitmap: TBitmap;
MyCanvas2: TControlCanvas;
files: string;
XScale, YScale: Double; //x,y坐标比例
Sero_x, Sero_y: Integer;
s: TStringList;
i: Integer;
x, y, x1, y1: Integer;
strTmp: string;
begin
files := dlgOpen1.FileName;
bitmap := TBitmap.Create;
MyCanvas1 := TControlCanvas.Create;
try
bitmap.LoadFromFile(files);
Mycanvas1.control := img1;
MyCanvas1.StretchDraw(img1.clientRect, bitmap);
XScale := (Abs((StrToInt(edt2.Text)) - (StrToInt(edt1.Text)))) / 100; //x比例
YScale := (Abs((StrToInt(edt4.Text)) - (StrToInt(edt3.Text)))) / 100; //y比例
Sero_x := Abs((StrToInt(edt2.Text)) - (StrToInt(edt1.Text)) - (StrToInt(edt1.Text)));
Sero_y := Abs((StrToInt(edt4.Text)) - (StrToInt(edt3.Text)) - (StrToInt(edt3.Text)));
lbl7.Caption := 'X比例:' + FloatToStr(XScale) + ' ' + 'Y比例:' + FloatToStr(YScale)
+ ' ' + 'X补偿:' + IntToStr(Sero_x) + ' ' + 'Y补偿:' + IntToStr(Sero_y);
for i := 0 to lst1.Count - 1 do
begin
s := split(lst1.Items[i], ',');
x := Trunc((StrToInt(s[0])) * XScale + Sero_x); //转换比例尺
y := Trunc(Sero_y - (StrToInt(s[1])) * YScale);
x1 := x + (StrToInt(edt5.Text) - 21);
y1 := y + (StrToInt(edt6.Text) + 6);
strTmp := s[0] + ',' + s[1];
if chk1.Checked = False then
begin
MyCanvas1.Brush.Style := bsClear;
MyCanvas1.Font.Color := clBlack; //字体颜色
MyCanvas1.Font.Name := 'MS Sans Serif';
MyCanvas1.Font.Style := [fsBold];
MyCanvas1.Textout(x1, y1, strTmp);
MyCanvas1.Brush.Style := bsClear;
end else
begin
MyCanvas1.Font.Color := clBlack; //字体颜色
MyCanvas1.Font.Name := 'MS Sans Serif';
MyCanvas1.Textout(x1, y1, strTmp);
end;
//Sleep(800);
end;
finally
// img1 .Picture.SaveToFile(Extractfilepath(Application.ExeName)+'01.bmp');
bitmap.Free;
MyCanvas1.Free;
end;
windows.Beep(500, 200);
end;图像画好了 请问怎么把画布上的图片保存下来啊 再下是新手 今天找了一天了都没找到办法canvas
解决方案 »
- 为什么在查找字符串"東"的时候会查找到一个“|”,应该如何解决?
- 可不可以在 bpl 中调用 dll
- 向表里增加数据项的小问题
- 表格打印问题
- 一个数据实时更新的问题,谢谢.
- 求一显示提示的快捷键
- 急求delphi 7 用流方式传输文件的例子!感激不尽~
- 100分求mmtools 2.0源码!uuuuuuuuuuuuuuuuuuuuuuuuuuuu ! [email protected]
- 请教个问题,indytcpclient已经连接上了tcpserver,tcpserver能否主动发信息给client?
- 难!难!难!150分大奉送,高手快来拿吧。
- 跪求delphi7 IdTCPServer1 如何动态绑定IP&Port
- delphi 服务怎么样等待进入系统之后调用外部程序
MyCanvas1 := Img1.Canvas;请注意,现在 MyCanvas1 等于 Img1.Canvas, 所以就不要再创建和释放 MyCanvas1 了。后面的绘图过程不需要修改,绘图完成后,直接保存文件即可。在 finally 后面你已经有一条保存文件的命令,恢复即可。其后需要用 Img1.Free 把对象释放。Img1 的 Parent 属性没有赋值,所以不会显示,是个隐藏对象。
procedure SaveCanvas(Canvas:TCanvas;FileName:String);
var
bmp:TBitmap;
begin
bmp:=TBitmap.Create;
try
bmp.Canvas.Assign(Canvas);
bmp.SaveToFile(FileName);
finally
bmp.Free;
end;
end;
var
bmp:TBitmap;
begin
bmp:=TBitmap.Create;
try
bmp.Canvas.Assign(Canvas as TCanvas);
bmp.SaveToFile(FileName);
finally
bmp.Free;
end;
end;
MyCanvas1.Textout(x1, y1, strTmp);
MyCanvas1.Brush.Style := bsClear;
end else
begin
MyCanvas1.Font.Color := clBlack; //字体颜色
MyCanvas1.Font.Name := 'MS Sans Serif';
MyCanvas1.Textout(x1, y1, strTmp);
end;
//Sleep(800);
end;
finally
// img1 .Picture.SaveToFile(Extractfilepath(Application.ExeName)+'01.bmp');
SaveCanvas(MyCanvas1,'c:\123.bmp');
bitmap.Free;
MyCanvas1.Free;
var
dc: hdc;
Mycan: Tcanvas;
R: TRect;
Mybmp:TBitmap;
p, CP:TPoint ;
begin
Mybmp := Tbitmap.Create; {建立BMPMAP }
Mycan := TCanvas.Create; {屏幕截取}
dc := GetWindowDC(0); try
p.x:= Panel1.Left;
p.y:= Panel1.Top;
CP:= ClientToScreen(p); Mycan.Handle := dc;
R := Rect(CP.x,CP.y,CP.x+Panel1.Width,CP.y+Panel1.Height);
Mybmp.Width := Panel1.Width;
Mybmp.Height := Panel1.Height;
Mybmp.Canvas.CopyRect(Mybmp.Canvas.ClipRect,Mycan,R);
mybmp.SaveToFile('E:\test.bmp');
finally
releaseDC(0, DC);
mycan.Free;
mybmp.Free;
end;
end; 呃 这样解决的...还是谢谢楼上的朋友