Текущий архив: 2003.06.05;
Скачать: CL | DM;

Вниз

Как сохранить Canvas в bmp файл?   Найти похожие ветки 

← →
greenrul ©   (2003-02-19 12:15) [0]

Я пробовал 2мя способами:
1)
Bitmap:=TBitmap.Create;
with Bitmap do
begin
Width:=pic.Width;
Height:=pic.Height;
Source := Rect(0, 0, Width, Height);
end;
Bitmap.Canvas.CopyRect(Dest, pic.Canvas, Source);
bitmap.SaveToFile(SaveDialog1.FileName);
Bitmap.Free;
сохраняется пустая картинка

2) то же самое, только вместо CopyRect и пр. был Assign - это вызывало еррор: Cannot assign TBitmapCanvas to TBitmapCanvas

---

← →
McSimm ©   (2003-02-19 12:36) [1]

Если pic типа TPicture, то

Для первого способа:
Bitmap.Canvas.CopyRect(Dest, pic.Bitmap.Canvas, Source);

Для второго
Bitmap.Assign(pic.Bitmap)

---

← →
greenrul ©   (2003-02-19 15:22) [2]

2McSimm
pic:TImage.

первый способ не работает (пустое изображение), второй у меня такой-же и был - не работал

---

← →
Valentain ©   (2003-02-19 18:21) [3]

Кусок рабочего кода (у меня, во всяком случае):

procedure ImageToBMP(MyPaintBox: TPaintBox; BmpFile: String);
var
Bitmap: TBitmap;
Source: TRect;
Dest: TRect;
begin
Bitmap:= TBitmap.Create;
try
with Bitmap do begin
Width:= MyPaintBox.Width;
Height:= MyPaintBox.Height;
Dest:= Rect(0, 0, Width, Height)
end;
with MyPaintBox do
Source:= Rect(0, 0, Width, Height);
Bitmap.Canvas.CopyRect(Dest, MyPaintBox.Canvas, Source);
Bitmap.SaveToFile(BmpFile);
finally
Bitmap.Free;
end;
end;

С уважением...

---

← →
reticon ©   (2003-02-19 18:28) [4]

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
procedure Button2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
Buffer: TBitmap;
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button2Click(Sender: TObject);
begin
with Form1.Canvas do
begin
Pen.Color:=clBlue;
Pen.Width:=5;
MoveTo(50,50);
LineTo(400,50);
LineTo(400,400);
LineTo(50,400);
LineTo(50,50);
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Buffer:=TBitmap.Create;
Buffer.Width:=450;
Buffer.Height:=450;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
BitBlt(Buffer.Canvas.Handle,0,0,450,450,Form1.Canvas.Handle,0,0,SRCCOPY);
Buffer.SaveToFile("SomeBmp.bmp");
end;

end.

---

← →
reticon ©   (2003-02-19 18:32) [5]

ЗЫ: если я правильно понял постановку задачи, то этот код работает.
типа аналог ПРИНТСКРИН на клаве :)

---

Страницы: 1 вся ветка

Текущий архив: 2003.06.05;
Скачать: CL | DM;

Наверх

Память: 0.47 MB
Время: 0.021 c