Функция 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]

Рамка образуется в правом и нижнем углу.

Функция PaintTo - как убрать рамку? Найти похожие ветки