VPF::Добавить в центр горизонтальную полосу

XAKEPEHOK

Дата 15.1.2009, 21:28 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 103
Регистрация: 18.10.2006
Где: Matrix

Репутация: нет
Всего: 0

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

есть исходное изображение. Вчисляется его верхняя и нижняя часть (примерно поровну). Вот между этими частями надо сделать промежуток в 30 пикселей. Т.е. увеличить высоту холста на 30 пкс, сдвиунть нижнюю часть на 30 grc? и промежуток закрасить.

Для изменения размера использую

Код


procedure ResizeBitmap(imgo, imgd: TBitmap; nw, nh: Integer);
 var
   xini, xfi, yini, yfi, saltx, salty: single;
   x, y, px, py, tpix: integer;
   PixelColor: TColor;
   r, g, b: longint;

   function MyRound(const X: Double): Integer;
   begin
     Result := Trunc(x);
     if Frac(x) >= 0.5 then
       if x >= 0 then Result := Result + 1
       else
         Result := Result - 1;
     // Result := Trunc(X + (-2 * Ord(X < 0) + 1) * 0.5);
  end;

 begin
   // Set target size 

  imgd.Width  := nw;
   imgd.Height := nh;

   // Calcs width & height of every area of pixels of the source bitmap

  saltx := imgo.Width / nw;
   salty := imgo.Height / nh;


   yfi := 0;
   for y := 0 to nh - 1 do
   begin
     // Set the initial and final Y coordinate of a pixel area

    yini := yfi;
     yfi  := yini + salty;
     if yfi >= imgo.Height then yfi := imgo.Height - 1;

     xfi := 0;
     for x := 0 to nw - 1 do
     begin
       // Set the inital and final X coordinate of a pixel area

      xini := xfi;
       xfi  := xini + saltx;
       if xfi >= imgo.Width then xfi := imgo.Width - 1;


       // This loop calcs del average result color of a pixel area
      // of the imaginary grid 

      r := 0;
       g := 0;
       b := 0;
       tpix := 0;

       for py := MyRound(yini) to MyRound(yfi) do
       begin
         for px := MyRound(xini) to MyRound(xfi) do
         begin
           Inc(tpix);
           PixelColor := ColorToRGB(imgo.Canvas.Pixels[px, py]);
           r := r + GetRValue(PixelColor);
           g := g + GetGValue(PixelColor);
           b := b + GetBValue(PixelColor);
         end;
       end;

       // Draws the result pixel

      imgd.Canvas.Pixels[x, y] :=
         rgb(MyRound(r / tpix),
         MyRound(g / tpix),
         MyRound(b / tpix)
         );
     end;
   end;
 end;

С этим проблем нет.

Вот код которым я пытаюсь проделать вышеописанное

Код


procedure TForm1.Button1Click(Sender: TObject);
var
verh,niz:integer;
pict:tpicture;
rect:trect;
canv:tcanvas
begin
canv:=tcanvas.Create;
pict:=tpicture.Create;
verh:=pict.Height div 2;
niz:=pict.Height-verh;
pic:=tpicture.Create;
pict.LoadFromFile('c:\123.bmp');
ResizeBitmap(pict[0].bitmap, pict[0].Bitmap, pict[0].Width,pict[0].Height+30);
//А вот ниже у меня начинается бред
canv:=pict.Bitmap.canvas;
rect:=canv.cliprect;
pict.Bitmap.canvas.copyrect(rect(0,verh+30,pict.width,pict.height),canv,rect(0,verh,pict.width,pict.height-30));
end;

Потом нужна процедура, которая будет делать обратное, т.е. убирать эту полосу. Если кто даст пример мне для того, как ее добавить, то убрать я уже сам смогу =)

подскажите пожалуйста.

Это сообщение отредактировал(а) XAKEPEHOK - 15.1.2009, 21:32

XAKEPEHOK

Дата 15.1.2009, 23:02 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 103
Регистрация: 18.10.2006
Где: Matrix

Репутация: нет
Всего: 0

Спасибо, разобрался порыв инфу про канву

XAKEPEHOK

Дата 15.1.2009, 23:34 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 103
Регистрация: 18.10.2006
Где: Matrix

Репутация: нет
Всего: 0

чет я вообще тупил. Вот как сделал

Код


var
  Form1: TForm1;
  pict: array [0..50] of tpicture;
  verh,niz:integer;
  sh:integer;
  //30

implementation


{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
i:integer;
rect1,rect2:trect;
canv:tcanvas;
int:integer;
bitmap:tbitmap;
begin
int:=spinedit1.Value;
canv:=tcanvas.Create;
if opendialog1.Execute=true then
begin
listbox1.Items:=opendialog1.Files;
progressbar1.Max:=listbox1.Count;
for i:=0 to listbox1.Count-1 do
begin
pict[i]:=tpicture.Create;
pict[i].LoadFromFile(listbox1.Items[i]);
verh:=pict[i].Height div 2;
niz:=pict[i].Height-verh;
pict[i].bitmap.Height:=pict[i].bitmap.Height+int;
sh:=pict[i].Width;
rect1:=rect(0,verh+1,sh,verh+niz+1);
rect2:=rect(0,verh+1+int,sh,verh+niz+int);
canv:=pict[i].Bitmap.canvas;
pict[i].Bitmap.canvas.copyrect(rect2,canv,rect1);
rect1:=rect(0,verh+1,sh,verh+1+int);
pict[i].Bitmap.canvas.FillRect(rect1);
pict[i].SaveToFile(listbox1.Items[i]);
progressbar1.Position:=i+1;
application.ProcessMessages();
end;
showmessage('готово');
end;
end;

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Звук, графика и видео \| Следующая тема »