VPF::Как загрузить фото прямопропорционально кнопки

Serhik_z

Дата 4.9.2005, 04:30 (ссылка)

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

Загрузка ...

Шустрый

Профиль
Группа: Awaiting Authorisation
Сообщений: 108
Регистрация: 4.12.2004

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

Как загрузить фото прямопропорционально самой кнопки speedbutton1,
(либо другой вариант кнопки),
если фото больше самой кнопки, и имеет нестандатрный формат 1024 х 703
Размер кнопки 200 х 200
(У фотки Height - что получится).
Либо что то, как у image (Stretch и Proportional)

Код


procedure TForm1.FormCreate(Sender: TObject);
 var
  w, h: integer;
begin
speedbutton1.glyph.loadfromfile('img\01.bmp');

w:=speedbutton1.Width;
h:=speedbutton1.Height;
speedbutton1.Width:=200;
speedbutton1.Height:=round(200/w*h);

speedbutton2.glyph.loadfromfile('img\02.bmp');
w:=speedbutton2.Width;
h:=speedbutton2.Height;
speedbutton2.Width:=200;
speedbutton2.Height:=round(200/w*h);
end;

Albinos_x

Дата 4.9.2005, 08:19 (ссылка)

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

Загрузка ...

Evil Skynet

Профиль
Группа: Комодератор
Сообщений: 3288
Регистрация: 28.5.2004
Где: X-6120400 Y-1 4624650

Репутация: 26
Всего: 108

А почему сам image не использовать как кнопку...

--------------------

"Кто владеет информацией, тот владеет миром"
Уинстон Черчилль

Illusion Dolphin

Дата 4.9.2005, 09:45 (ссылка)

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

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 1198
Регистрация: 3.5.2003

Репутация: 36
Всего: 63

Так?

Код


Type
  TRGB=record
  b,g,r : byte;
  end;

  ARGB=array [0..1] of TRGB;
  PARGB=^ARGB;
  PRGB = ^TRGB;

...

procedure StretchCool(x, y, Width, Height : Integer; var S, D : TBitmap);
var
  i,j,k,p,Sheight1:integer;
  p1: pargb;
  col,r,g,b : integer;
  Sh, Sw : Extended;
  Xp : array of PARGB;
begin
 s.PixelFormat:=pf24bit;
 d.PixelFormat:=pf24bit;
 if width+x>d.Width then
 d.Width:=width+x;
 if Height+y>d.Height then
 d.Height:=height+y;
 Sh:=S.height/height;
 Sw:=S.width/width;
 Sheight1:=S.height-1;
 SetLength(Xp,S.height);
 for i:=0 to Sheight1 do
 Xp[i]:=s.ScanLine[i];
 for i:=Math.Max(0,y) to height+y-1 do
 begin
  p1:=d.ScanLine[i];
  for j:=0 to  width-1 do
  begin
   col:=0;
   r:=0;
   g:=0;
   b:=0;
   for k:=Round(Sh*(i-y)) to Min(S.Height-1,Round(Sh*(i+1-y))-1) do
   begin
    for p:=Round(Sw*j) to Min(Round(Sw*(j+1))-1,S.Width-1) do
    begin
     inc(col);
     inc(r,Xp[k,p].r);
     inc(g,Xp[k,p].g);
     inc(b,Xp[k,p].b);
    end;
   end;
   if (col<>0) and (j+x>0) then
   begin
    p1[j+x].r:=r div col;
    p1[j+x].g:=g div col;
    p1[j+x].b:=b div col;
   end;
  end;
 end;
end;

procedure ProportionalSize(aWidth, aHeight: Integer; var aWidthToSize, aHeightToSize: Integer);
begin
 If (aWidthToSize<aWidth) and (aHeightToSize<aHeight) then
 begin
  Exit;
 end;
 if (aWidthToSize = 0) or (aHeightToSize = 0) then
 begin
  aHeightToSize := 0;
  aWidthToSize  := 0;
 end else begin
  if (aHeightToSize/aWidthToSize) < (aHeight/aWidth) then
  begin
   aHeightToSize := Round ( (aWidth/aWidthToSize) * aHeightToSize );
   aWidthToSize  := aWidth;
  end else begin
   aWidthToSize  := Round ( (aHeight/aHeightToSize) * aWidthToSize );
   aHeightToSize := aHeight;
  end;
 end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
 w,h : integer;
 s,d : TBitmap;
begin
 s := TBitmap.create;
 d := TBitmap.create;
 s.LoadFromFile('D:\Dmitry\My Pictures\Favorite Pictures\Knoking on the Heavens'' door.bmp');
 w:=s.Width;
 h:=s.Height;
 if true then
 begin
  {сохраняем пропорции изображения}
  ProportionalSize(speedbutton1.Width,speedbutton1.Height,w,h);
  StretchCool(0,0,w,h,s,d);
 end else
 begin
  {не сохраняем пропорции изображения}
  StretchCool(0,0,speedbutton1.Width,speedbutton1.Height,s,d);
 end;
 s.free;
 speedbutton1.glyph:=d;
 d.free;
end;

--------------------

В мире всего две бесконечности: вселенная и человеческая глупость... На счёт вселенной я не уверен.
Шифрование и организация фотографий - Photo Database 4.5

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