| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Выделение прозрачным прямоугольником

ANTPro ©   (2007-10-15 17:23:00) 

Как это реализованно в проводнике?

---

Lacmus   (2007-10-15 20:03:00) [1]

Пример использования



unit Unit75;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls, ExtCtrls, ComCtrls, ShellCtrls;

type
 TShellListViewEx = class(TShellListView)
   procedure WMPaint(var aMessage: TMessage); message WM_PAINT;
 end;

 TShellListView = class(TShellListViewEx);

 TForm75 = class(TForm)
   ShellListView1: TShellListView;
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form75: TForm75;

implementation

{$R *.dfm}

function AlphaBlend(hdcDest: HDC; nXOriginDest, nYOriginDest, nWidthDest,
 nHeightDest: Integer; hdcSrc: HDC; nXOriginSrc, nYOriginSrc, nWidthSrc,
 nHeightSrc: Integer; BlendFunction: BLENDFUNCTION): BOOL; stdcall; external 'Msimg32.dll';

{ GR32_LowLevel.pas }

procedure FillLongword(var X; Count: Integer; Value: Longword);
asm
// EAX = X
// EDX = Count
// ECX = Value
       PUSH    EDI

       MOV     EDI,EAX  // Point EDI to destination
       MOV     EAX,ECX
       MOV     ECX,EDX
       TEST    ECX,ECX
       JS      @exit

       REP     STOSD    // Fill count dwords
@exit:
       POP     EDI
end;

procedure TShellListViewEx.WMPaint(var aMessage: TMessage);
var
 Bitmap: TBitmap;
 BlendFunction: TBlendFunction;
begin
 inherited;

 Bitmap := TBitmap.Create;
 try
   Bitmap.PixelFormat := pf32Bit;
   Bitmap.SetSize(200, 100);

   FillLongword(Bitmap.ScanLine[Bitmap.Height - 1]^, Bitmap.Width * Bitmap.Height, $FFFF0000);
//    FillLongword(Bitmap.ScanLine[0]^, Bitmap.Width * Bitmap.Height, $FFFF0000);

   BlendFunction.BlendOp := AC_SRC_OVER;
   BlendFunction.BlendFlags := 0;
   BlendFunction.SourceConstantAlpha := 100;
   BlendFunction.AlphaFormat := AC_SRC_ALPHA;
   Unit75.AlphaBlend(Canvas.Handle, 50, 50, Bitmap.Width, Bitmap.Height,
      Bitmap.Canvas.Handle, 0, 0, Bitmap.Width, Bitmap.Height, BlendFunction)
 finally
   Bitmap.Free
 end
end;

end.



---

ANTPro   (2007-10-15 19:15:00) [2]

> [1] Palladin ©   (15.10.07 17:54)

Это ясно :)


> [2] Lacmus ©   (15.10.07 18:11)

Спасибо. Осталось разобраться, как ей пользоваться.

procedure offtop;
begin
 Что зашифровали маньяки из M$ по ссылке? Целых 10кб чего-то непонятного :(
end;

---

Lacmus   (2007-10-15 18:11:00) [3]

>ANTPro ©   (15.10.07 17:23)  

AlphaBlend ?

http://msdn2.microsoft.com/en-us/library/ms532324.aspx

---

Palladin   (2007-10-15 17:54:00) [4]

да, в общем то, как всегда... DragStart, MouseMove

---

Наверх