Скачать: CL | DM;

Функция 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 вся ветка

Скачать: CL | DM;



Память: 0.45 MB
Время: 0.028 c