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

解决方案 »

  1.   

    有很多方法,比较直观的方法就是把 canvas 上的画面复制到一个 TImage 对象的 canvas 上(用 CopyRect 方法)。TImage 保存图像很容易(SaveToFile)。要想保存成 JPG 格式,还要把图像从 TImage 转移到一个 TJPegImage 对象(用 Assign 方法),然后再保存(也是 SaveToFile)。
      

  2.   

    这样的话,不妨用更简单的方法吧:创建一个 TImage 对象,直接用其 canvas 画图。var Img1: TImage;Img1 := TImage.Create(nil);
    MyCanvas1 := Img1.Canvas;请注意,现在 MyCanvas1 等于 Img1.Canvas, 所以就不要再创建和释放 MyCanvas1 了。后面的绘图过程不需要修改,绘图完成后,直接保存文件即可。在 finally 后面你已经有一条保存文件的命令,恢复即可。其后需要用 Img1.Free 把对象释放。Img1 的 Parent 属性没有赋值,所以不会显示,是个隐藏对象。
      

  3.   


    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;
      

  4.   

    楼上的朋友 我该怎么调用啊? SaveCanvas(MyCanvas1,'c:\123.bmp'); 结果报错..
      

  5.   

    procjet procjie1.exe raised exception class EconverError with message 'cannot assign a TcontrolCanvas to a TBitmapCanvas' Process stopped
      

  6.   

    好吧。。procedure SaveCanvas(Canvas:TControlCanvas;FileName:String);
    var
      bmp:TBitmap;
    begin
      bmp:=TBitmap.Create;
      try
        bmp.Canvas.Assign(Canvas as TCanvas);
        bmp.SaveToFile(FileName);
      finally
        bmp.Free;
      end;
    end;
      

  7.   

    呃 一样的错误啊 我是放在这一段的
           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;
      

  8.   

    这样,你把MyCanvas1改为TCanvas而不是TControlCanvas,然后用回第一段函数
      

  9.   

    楼上的兄弟 能帮我把源码改下不 怎么调试都过不了 当我吧Mycanvas1 修改为Tcanvas 后 pnl1就不能把赋值给mycanvas1了 
      

  10.   

    procedure TForm1.Button3Click(Sender: TObject);
    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; 呃 这样解决的...还是谢谢楼上的朋友