Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Компоненты Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 21.11.2011, 17:01   #1
X@OC
Форумчанин
 
Аватар для X@OC
 
Регистрация: 18.06.2010
Сообщений: 273
Вопрос Как установить прозрачность в TImage или TBitMap

Доброго времени суток

Есть два компонента TImage и TBitMap
возможно ли в каком нибудь из компоненте установить полупрозрачность?

Пытался делать через
Код:
TransparentMode
TransparentColor
но эти методы убирают пиксел целиком.

пытался получить следующий результат

Было название "TImage or TBitMap"
Изображения
Тип файла: gif 1.gif (7.6 Кб, 172 просмотров)

Последний раз редактировалось mihali4; 24.11.2011 в 23:24.
X@OC вне форума Ответить с цитированием
Старый 22.11.2011, 11:15   #2
x128
Форумчанин
 
Регистрация: 03.02.2010
Сообщений: 178
По умолчанию

AlphaBlend
x128 вне форума Ответить с цитированием
Старый 22.11.2011, 13:45   #3
X@OC
Форумчанин
 
Аватар для X@OC
 
Регистрация: 18.06.2010
Сообщений: 273
По умолчанию

x128 извените пожалуста за такую просьбу
незаструднит вас скинуть рабочий проект с AlphaBlend?
уменя Delphi 7

спасибо
X@OC вне форума Ответить с цитированием
Старый 22.11.2011, 14:13   #4
Freezer
Пользователь
 
Аватар для Freezer
 
Регистрация: 04.02.2007
Сообщений: 37
По умолчанию

можешь это сделать ручками, вот набор нужных функций, правда рисует еще и с эффектом тени, но думаю подправишь где нужно:

Код:
//=============================================================================================
function MixBytes(FG, BG, TRANS: byte): byte;//змішує 1 канал двох кольорів з даданою прозорістю
//---------------------------------------------------------------------------------------------
begin
 { asm
     push bx  // push some regs
    push cx
     push dx
     mov DH,TRANS // remembering Transparency value (or Opacity - as you like)
    mov BL,FG    // filling registers with our values
    mov AL,DH    // BL = ForeGround (FG)
    mov CL,BG    // CL = BackGround (BG)
    xor AH,AH    // Clear High-order parts of regs
    xor BH,BH
     xor CH,CH
     mul BL       // AL=AL*BL
    mov BX,AX    // BX=AX
    xor AH,AH
     mov AL,DH
     xor AL,$FF   // AX=(255-TRANS)
    mul CL       // AL=AL*CL
    add AX,BX    // AX=AX+BX
    shr AX,8     // Fine! Here we have mixed value in AL
    pop dx       // Hm... No rubbish after us, ok?
    pop cx
     pop bx       // Bye, dear Assembler - we go home to Delphi!
  end;            }
  Result := round(bg + (fg - bg)/255*TRANS);
end{function MixBytes(FG, BG, TRANS: byte): byte;};

//=============================================================================================
function MixColors(FG, BG: TColor; T: byte): TColor;
//---------------------------------------------------------------------------------------------
var r,g,b:byte;
begin
  R := MixBytes(FG and 255,BG and 255,T); // extracting and mixing Red
  G := MixBytes((FG shr 8) and 255,(BG shr 8) and 255,T); // the same with green
  B := MixBytes((FG shr 16) and 255,(BG shr 16) and 255,T); // and blue, of course
  Result := r+g*256+b*65536; // finishing with combining all channels together
end {function MixColors(FG, BG: TColor; T: byte): TColor;};


//=============================================================================================
procedure MixPixel      // накладає колір на заданий піксель Canvas'а з прозорістю
( Var Dest : TCanvas;   // Canvas на який потрібно накласти
  X, Y : integer;       // координати пікселя
  Color : TColor;       // колік для накладання
  Alpha : byte          // параметр прозорості 0..255
);
//---------------------------------------------------------------------------------------------
begin
  Dest.Pixels[x,y] := MixColors(ColorToRGB(Color), ColorToRGB(Dest.Pixels[x,y]), alpha);
end;

//=============================================================================================
procedure DrawWithShadow  //Малює на Canvas'і заданий регіон з ефектом тіні
( Source : TCanvas;       //Canvas з якого береться малюнок
  sRect : TRect;          //регіон з який буде промальвуватись
  Dest : TCanvas;         //Canvas де буде промальовання
  dX, dY : integer;       //координати на Canvas'і де потрібно промалювати
  SourceAlhpa : byte = 255;     //параметр прозорості базового малюнку 0..255
  ShadowAlhpa : byte  = 70    //параметр прозорості тіні 0..255
);
//---------------------------------------------------------------------------------------------
var x, y : integer;
    xCol, tCol{, dCol} : TColor;
    fx, fy : integer;
begin
  tCol := 0;

  fx := 0;
  fy := 0;
  Dest.CopyMode := cmSrcCopy;
  //відмальовка ефекту по осі X
  for y := sRect.Top to sRect.Bottom - 1 do begin
    for X := sRect.Left to sRect.Right - 1 do begin
      xCol := Source.Pixels[x,y];
      if xCol <> clWhite then begin
        MixPixel(dest, x + dx - sRect.Left, y + dy - sRect.Top, xCol, SourceAlhpa);
        if x > 0 then begin
          if Source.Pixels[x-1, y] = clWhite then begin
            MixPixel(dest, x - 1 + dx, y + dy, xCol, ShadowAlhpa);
          end;
        end;
        if x < sRect.Right then begin
         fx := 1;
         tCol := xCol;
        end;
 //       Dest.Pixels[x + dx, y + dy] := xCol;
      end else
      if fx <> 0 then begin
        MixPixel(dest, x + dx, y + dy, tCol, ShadowAlhpa);
        fx := 0;
      end;
    end;
  end;
  //відмальовка ефекту по осі Y
  for X := sRect.Left to sRect.Right - 1 do begin
    for y := sRect.Top to sRect.Bottom - 1 do begin
      xCol := Source.Pixels[x,y];
      if xCol <> clWhite then begin
        if y > 0 then begin
          if Source.Pixels[x, y-1] = clWhite then begin
            MixPixel(dest, x + dx, y - 1 + dy, xCol, ShadowAlhpa);
          end;
        end;
        if y < sRect.Bottom then begin
         fy := 1;
         tCol := xCol;
        end;
//        Dest.Pixels[x + dx, y + dy] := xCol;
      end else
      if fy <> 0 then begin
        MixPixel(dest, x + dx, y + dy, tCol, ShadowAlhpa);
        fy := 0;
      end;
    end;
  end;
end{procedure DrawWithShadow(Source : TCanvas; sRect : TRect; Dest : TCanvas; dX, dY : integer);};
Не грузи, и не грузим будешь...
Freezer вне форума Ответить с цитированием
Старый 23.11.2011, 12:09   #5
x128
Форумчанин
 
Регистрация: 03.02.2010
Сообщений: 178
По умолчанию

X@OC, для delphi 7 будет проще использовать FastDIB

Код:
uses FastDIB;
...
procedure TForm1.Button1Click(Sender: TObject);
var
  bmp: TFastDIB;
begin
  Image1.Picture.LoadFromFile('test1.bmp');

  bmp:=TFastDIB.Create;
  bmp.LoadFromFile('test2.bmp');

  bmp.AlphaDraw(Image1.Canvas.Handle, 0,0, 128, false);

  bmp.Free;
end;

Последний раз редактировалось x128; 23.11.2011 в 17:31. Причина: упростил
x128 вне форума Ответить с цитированием
Старый 23.11.2011, 17:49   #6
X@OC
Форумчанин
 
Аватар для X@OC
 
Регистрация: 18.06.2010
Сообщений: 273
По умолчанию

Всем спасибо за помощь

Но я нашел PNGImage

и еще дополнительный вопрос если можно

где достать компоненты TSTDPanel,TList?
не могу найти

Последний раз редактировалось X@OC; 23.11.2011 в 18:37.
X@OC вне форума Ответить с цитированием
Старый 23.11.2011, 23:18   #7
Delphi_ProGer
Форумчанин
 
Регистрация: 30.10.2010
Сообщений: 524
По умолчанию

Цитата:
Сообщение от X@OC Посмотреть сообщение
TList?


TList в по дефолту есть.
Delphi_ProGer вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
как вытянуть данные из txt или memo в TImage radiokarazinec Общие вопросы Delphi 3 14.12.2010 06:53
Timage динамическое создание, не работает прозрачность Zerofill Мультимедиа в Delphi 3 25.03.2010 15:47
TForm & TImage & PNG & Прозрачность delphi_beginner Общие вопросы Delphi 7 19.09.2009 08:46
Работа с TImage-как установить длину массива TRGBTriple? Саня Компоненты Delphi 1 04.08.2007 11:15
Подскажите как установить G32 или DelphiX Teen4jump Общие вопросы Delphi 3 26.06.2007 23:50