Функция PaintTo - как убрать рамку? [D7, XP]
allucard © (2007-04-30 15:14:00)
Доброго дня.
Есть функция которой фоткаю форму передвигая 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:00) [1]
Рамка образуется в правом и нижнем углу.
Наверх 
ЧАТ |
Орешник |
|
