Форум: "Начинающим";
Текущий архив: 2007.05.20;
Скачать: [xml.tar.bz2];
Вниз
Функция PaintTo - как убрать рамку? Найти похожие ветки
← →
allucard (2007-04-30 15:14) [0]Доброго дня.
Есть функция которой фоткаю форму передвигая scrolls и сохраняю её в файл, но каждый свой снимок PaintTo обводит в рамку чёрного цвета, как избежать этого?procedure TForm1.Button4Click(Sender: TObject);
const
A4_Height = 900;
A4_Width = 630;
var
Ofs: Integer;
Result: TBitmap;
h: integer;
begin
with form2 do
begin
Result := TBitmap.Create;
try
Result.Width := A4_Width;
Result.Height := A4_Height;
Result.Canvas.Brush := Brush;
Result.Canvas.FillRect(ClientRect);
Result.Canvas.Lock;
try
if GetWindowLong(Handle, GWL_STYLE) and WS_BORDER <> 0 then
Ofs := -1 // Don"t draw form border
else
Ofs := 0; // There is no border
VertScrollBar.Position := 0;
VertScrollBar.Range := A4_Height * 2;
h := 0;
while h <= Result.Height - height do
begin
PaintTo(Result.Canvas.Handle, Ofs, h + Ofs);
VertScrollBar.Position := VertScrollBar.Position + Height;
h := h + Height;
if h + Height > Result.Height then Height := Result.Height - h;
end;
finally
VertScrollBar.Range := A4_Height;
Result.Canvas.Unlock;
end;
except
Result.Free;
raise;
end;
Result.SaveToFile("C:\123.bmp");
end;
Спасибо.
← →
allucard (2007-05-03 08:10) [1]Рамка образуется в правом и нижнем углу.
Страницы: 1 вся ветка
Форум: "Начинающим";
Текущий архив: 2007.05.20;
Скачать: [xml.tar.bz2];
Память: 0.44 MB
Время: 0.043 c
