В чем моя ошибка?

← →
DimaK (2003-12-24 22:50) [0]

Целый день убил, так что-то и не понял. Вот мой код:

procedure TForm1.SaveBitmap;
var Bitmap: TBitmap;
MyRect: TRect;
begin
// Задание координат копирования (отступ слева, сверху, ширина, высота)
MyRect:=Rect(Panel1.Left+Image1.Left,
Panel1.Top+Image1.Top,
Panel1.Left+Image1.Width,
Panel1.Top+Image1.Height);
//
Bitmap:=TBitmap.Create;
Bitmap.Width:=547;
Bitmap.Height:=316;
//
try
with Bitmap.Canvas do
CopyRect(Clientrect, Canvas, MyRect);
Bitmap.SaveToFile(SavePictureDialog1.FileName);
finally
Bitmap.Free;
end;
end;

Суть такая, допустим на форме где-то лежит Panel1, на котором лежит Image1. Загружаю картинку (bmp) в Image. Далее допустим создаю ротомок Label, и распологаю его на картинке. В итоге получается картинка, на которой в определенных местах есть текст (те самые созданные Label). Вот теперь надо эту картинку сохранить (вместе с текстом), т.е. скопировать экран именно в координатах нахождения Image и сохранить его в файл.
Да совсем забыл, файл должен быть 547 точек по ширине и 316 по высоте.
Мой код впринципе все делает, но он почему-то масштабирует картинку, в итоге получается, что вырезает, сохраняет, но картинка получается больше (где-то 715 на 400), естественно получается обрезанная и как-бы увеличенная из за чего теряется и качество.
Может кто знает как правильно скопировать экран по определенным координатам, буду очень благодарен!

← →
Anatoly Podgoretsky (2003-12-24 23:07) [1]

Убери with и поставь точку останова на Bitmap.SaveToFile и посмотри Width/Height

← →
DimaK (2003-12-25 00:16) [2]

Так дело в том, что я не могу поставить точку остановки, делфя в этот момент выполняет недопустимую операцию :(

← →
Думкин (2003-12-25 07:23) [3]

Допустим
Image1.Left = 100;
Image1.Width = 50;

А теперь скажи что у тебя в MyRect.

← →
Babay (2003-12-25 08:00) [4]

А может лучше просто отрисовать перед сохранением лабельки на битмапе и сохранить, а затем битмап восстановить.

← →
BaDeVlad (2003-12-25 09:12) [5]

Что у тебя получается? если убрать with:

Bitmap.Canvas.CopyRect(Clientrect, Bitmap.Canvas, MyRect);

по-моему так?

← →
Думкин (2003-12-25 09:17) [6]

> [5] BaDeVlad © (25.12.03 09:12)

Нет, не это.

← →
Teetotaller (2003-12-25 09:41) [7]

В CopyRect - ClientRect, это прямоугольник формы, не битмапа.
Сам подумай.
Вот и получается растягивание при копировании.

← →
TUser (2003-12-25 09:46) [8]

А тебе это все озязательно через Label делать? C TextOut"ом вообще думать не придется, и быстрее будет.

← →
DimaK (2003-12-25 23:15) [9]

Большое спасибо всем, всетаки натолкнули на мысль :)
Все получилось, если кому интересно как скопировать область экрана по координатам отдельного компонента, смотрите код:

function GetSystemPalette : HPalette;
var PaletteSize:integer;
LogSize:integer;
LogPalette:PLogPalette;
DC : HDC;
Focus : HWND;
begin
result:=0;
Focus:=GetFocus;
DC:=GetDC(Focus);
try
PaletteSize:=GetDeviceCaps(DC, SIZEPALETTE);
LogSize:=SizeOf(TLogPalette)+(PaletteSize-1)*SizeOf(TPaletteEntry);
GetMem(LogPalette, LogSize);
try
with LogPalette^ do
begin
palVersion:=$0300;
palNumEntries:=PaletteSize;
GetSystemPaletteEntries(DC, 0, PaletteSize, palPalEntry);
end;
result:=CreatePalette(LogPalette^);
finally
FreeMem(LogPalette, LogSize);
end;
finally
ReleaseDC(Focus, DC);
end;
end;

function CaptureScreenRect(ARect : TRect) : TBitmap;
var ScreenDC : HDC;
begin
Result:=TBitmap.Create;
with result, ARect do
begin
Width:=Right-Left;
Height:=Bottom-Top;
ScreenDC:=GetDC(0);
try
BitBlt(Canvas.Handle, 0,0,Width,Height,ScreenDC, Left, Top, SRCCOPY );
finally
ReleaseDC(0, ScreenDC);
end;
Palette:=GetSystemPalette;
end;
end;

function CaptureClientImage(Control : TControl) : TBitmap;
begin
with Control, Control.ClientOrigin do
result:=CaptureScreenRect(Bounds(X,Y,ClientWidth,ClientHeight));
end;

procedure TForm1.Button1Click(Sender: TObject);
var bmp: TBitmap;
begin
bmp:=TBitmap.Create;
bmp.Width:=546;
bmp.Height:=316;
bmp:=CaptureClientImage(Image1);
bmp.SaveToFile("c:\screen.bmp");
bmp.Free;
end;

В чем моя ошибка? Найти похожие ветки