zoukankan      html  css  js  c++  java
  • GDI+用PNG图片做半透明异型窗口

    http://hi.baidu.com/bluew/blog/item/2ecbe58bf93a937d9f2fb4de.html2007-08-09 00:52   我是用PNG图片Alpha透明的方式做的窗口,这种方法一个好处就是不用通过编程来控制窗口外观。Delphi7设置一下窗体的BorderStyle、Color、Transparent、TransparentColor属性就可以搞定异型窗口,但不是半透明的。UpdateLayeredWindow函数里设置Blend函数就可以实现半透明异型窗体。最近有个哥们网上弄来个老外用VC写的代码,他找人翻译成BCB的,因为BCB本身就支持GDI+,而Delphi不支持,所以我又找GDI+的类,我又改写成Delphi版的了,程序编译运行候效果很不错。需要两个pas文件:GDIPAPI, GDIPOBJ网上都有,唯一缺点是无法放VCL组件!放了也看不到,我真是晕啊,各位也帮忙看一下怎么解决??以下是全部源码:
    //======================================
    unit Unit1;

    interface

    uses
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
    Dialogs,
    GDIPAPI, GDIPOBJ, Menus, StdCtrls; //http://www.progdigy.com/modules.php?name=gdiplus

    type
    TForm1 = class(TForm)
    PopupMenu1: TPopupMenu;
    Close1: TMenuItem;
    ChangeSkin1: TMenuItem;
    About1: TMenuItem;
    N1: TMenuItem;
    N2: TMenuItem;
    Edit1: TEdit;
    Button1: TButton;
    Stayontop1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
    Shift: TShiftState; X, Y: Integer);
    procedure Close1Click(Sender: TObject);
    procedure ChangeSkin1Click(Sender: TObject);
    procedure About1Click(Sender: TObject);
    procedure Stayontop1Click(Sender: TObject);
    private
    m_Blend: BLENDFUNCTION;
    procedure SetTransparent(lpSkinFile: WideString; nTran: integer);
    { Private declarations }
    public
    { Public declarations }
    end;

    var
    Form1: TForm1;

    implementation

    {$R *.dfm}

    procedure TForm1.FormCreate(Sender: TObject);
    begin
    BorderStyle := bsNone;
    m_Blend.BlendOp := AC_SRC_OVER; // the only BlendOp defined in Windows 2000
    m_Blend.BlendFlags := 0; // Must be zero
    m_Blend.AlphaFormat := AC_SRC_ALPHA;//This flag is set when the bitmap has an Alpha channel
    m_Blend.SourceConstantAlpha := 255;
    if(FileExists(ExtractFilePath(ParamStr(0)) + 'test.png')) then
    SetTransparent(WideString(ExtractFilePath(ParamStr(0)) + 'test.png'), 100);
    // Stay on top
    SetWindowPos(Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE);
    end;

    procedure TForm1.SetTransparent(lpSkinFile: WideString; nTran: integer);
    var
    GPImage: TGPImage;
    GPGraph: TGPGraphics;
    m_Image: TGPImage;

    m_hdcMemory: HDC;
    hdcScreen: HDC;
    hBMP: HBITMAP;

    sizeWindow: SIZE;
    rct: TRECT;
    ptSrc: TPOINT;
    begin
    // Use GDI+ load image
    GPImage:= TGPImage.Create();
    m_Image:= GPImage.FromFile( lpSkinFile );

    // Create Compatible Bitmap
    hdcScreen := GetDC(0);
    m_hdcMemory := CreateCompatibleDC(hdcScreen);
    hBMP := CreateCompatibleBitmap(hdcScreen, m_Image.GetWidth(), m_Image.GetHeight());
    SelectObject(m_hdcMemory, hBMP);

    // Alpha Value
    if (nTran<0) or (nTran >100) then
    nTran := 100;
    m_Blend.SourceConstantAlpha := round(nTran * 2.55); // 1~255
    GetWindowRect(Handle, rct);

    GPGraph:= TGPGraphics.Create(m_hdcMemory);
    GPGraph.DrawImage(m_Image, 0, 0, m_Image.GetWidth(), m_Image.GetHeight());

    sizeWindow.cx:= m_Image.GetWidth();
    sizeWindow.cy:= m_Image.GetHeight();

    ptSrc.x:= 0;
    ptSrc.y:= 0;

    // Set Window style
    SetWindowLong(Handle, GWL_EXSTYLE, GetWindowLong(Handle, GWL_EXSTYLE) or WS_EX_LAYERED);

    // perform the alpha blend
    UpdateLayeredWindow(Handle, hdcScreen, nil,
    @sizeWindow, m_hdcMemory, @ptSrc, 0, @m_Blend, ULW_ALPHA);
    //Release resources
    GPGraph.ReleaseHDC(m_hdcMemory);
    ReleaseDC(0, hdcScreen);
    hdcScreen := 0;

    DeleteObject(hBMP);

    DeleteDC(m_hdcMemory);
    m_hdcMemory := 0;

    m_Image.Free;
    GPGraph.Free;
    end;

    procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
    Shift: TShiftState; X, Y: Integer);
    begin
    if(Button = mbLeft) then
    begin
    ReleaseCapture();
    Perform(WM_SYSCOMMAND, SC_MOVE or HTCAPTION, 0);
    end;
    end;

    procedure TForm1.Close1Click(Sender: TObject);
    begin
    Close();
    end;

    procedure TForm1.ChangeSkin1Click(Sender: TObject);
    var
    dlgOpen: TOpenDialog;
    begin
    dlgOpen := TOpenDialog.Create(Self);
    dlgOpen.Filter := 'PNG file(*.png)|*.png';
    if(dlgOpen.Execute()) then
    begin
    SetTransparent(WideString(dlgOpen.FileName), 100);
    Invalidate();
    end;
    dlgOpen.Free;
    end;

    procedure TForm1.About1Click(Sender: TObject);
    begin
    MessageDlg('GDI plus API by: http://www.progdigy.com '#13 +
    'C++Builder example by: http://www.ccrun.com '#13 +
    'Delphi example by: http://www.handsomesoft.com ',mtInformation, [mbOK], 0);
    end;

    procedure TForm1.Stayontop1Click(Sender: TObject);
    var
    mi: TMenuItem;
    WindowPos: HWND;
    begin
    mi := Sender as TMenuItem;
    mi.Checked := not mi.Checked;
    if mi.Checked then
    WindowPos:= HWND_TOPMOST
    else
    WindowPos:= HWND_NOTOPMOST;
    SetWindowPos(Handle, WindowPos,
    0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE);
    end;

    end.

  • 相关阅读:
    背景图片填充问题
    a:hover 等伪类选择器
    jQuery中animate()方法用法实例
    响应式框架Bootstrap
    HTTP入门
    jQuery选择器
    httplib urllib urllib2 pycurl 比较
    校招
    JAVA描述的简单ORM框架
    Roman to Integer
  • 原文地址:https://www.cnblogs.com/blogpro/p/11446637.html
Copyright © 2011-2022 走看看