Delphi GDI+ 데스크톱 가사

        ，        TTimer   TPopupMenu，TTimer Interval   1500，TPopupMenu        ，   “    ”、“    ” “  ”。

         。       ：
unit Unit1; 

interface 

uses 
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
  Dialogs, IGDIPlus, ExtCtrls, Menus; 

type 
  TForm1 = class(TForm) 
    tmr1: TTimer; 
    pm1: TPopupMenu; 
    mni_topMost: TMenuItem; 
    mni_transparent: TMenuItem; 
    mni_exit: TMenuItem; 
    procedure FormCreate(Sender: TObject); 
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton; 
      Shift: TShiftState; X, Y: Integer); 
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, 
      Y: Integer); 
    procedure tmr1Timer(Sender: TObject); 
    procedure mni_topMostClick(Sender: TObject); 
    procedure MouseLeave(var Msg: TMessage);message WM_MOUSELEAVE; 
    procedure mni_transparentClick(Sender: TObject); 
    procedure mni_exitClick(Sender: TObject); 
  private 
    m_Kind: Integer;        //         
    m_bBack: Boolean;       //       
    m_pszbuf: array[0..5] of WideString;   //          
    function UpdateDisplay(pszbuf: WideString;bBack: Boolean = False; 
        Transparent: Integer = 100):Boolean; 
  public 
    { Public declarations } 
  end; 

var 
  Form1: TForm1; 

implementation 

{$R *.dfm} 
{------------------------------------------------------------------------------- 
     :    TForm1.UpdateDisplay 
    :             
    :      pszbuf: WideString;            
             bBack: Boolean;                
             Transparent: Integer         
     :    Boolean 
-------------------------------------------------------------------------------} 
function TForm1.UpdateDisplay(pszbuf: WideString;bBack: Boolean;Transparent: Integer):Boolean; 
var 
  hdcTemp,hdcScreen,m_hdcMemory: HDC; 
  hBitMap: Windows.HBITMAP; 
  blend: BLENDFUNCTION;      //                         
  rct: TRect; 
  ptWinPos,ptSrc: TPoint; 
  graphics: IGPGraphics;     //     GDI+      
  fontFamily: IGPFontFamily; //                           
  path: IGPGraphicsPath;     //                
  strFormat: IGPStringFormat;//        ，     
  pen,pen1,pen2: IGPPen;     //               
  linGrBrush,linGrBrushW: IGPLinearGradientBrush;  //         Brush 
  brush: IGPSolidBrush;      //      ，           
  image: TGPImage;           //           GDI+   
  i: Integer; 
  sizeWindow: SIZE; 
begin 
  //---------------------  ：     -------------------------------------- 
  hdcTemp := GetDC(Self.Handle); 
  m_hdcMemory := CreateCompatibleDC(hdcTemp); 
  hBitMap := CreateCompatibleBitmap(hdcTemp,755,350); 
  SelectObject(m_hdcMemory,hBitMap); 
  if (Transparent < 0) or (Transparent > 100) then 
    Transparent := 100; 
  with blend do 
  begin 
    BlendOp := AC_SRC_OVER;     //            
    BlendFlags := 0; 
    AlphaFormat := AC_SRC_ALPHA;//        alpha   
    SourceConstantAlpha :=Trunc(Transparent * 2.55);  //        
  end; 
  hdcScreen := GetDC(Self.Handle); 
  GetWindowRect(Self.Handle,rct); 
  ptWinPos := Point(rct.Left,rct.Top); 
  graphics := TGPGraphics.Create(m_hdcMemory); 
  graphics.SetSmoothingMode(SmoothingModeAntiAlias); //    （   ） 
  graphics.SetInterpolationMode(InterpolationModeHighQualityBicubic);//      ，      
  fontFamily := TGPFontFamily.Create('    '); //△  ，    '    '   
  strFormat := TGPStringFormat.Create(); 
  path := TGPGraphicsPath.Create(); 
  //---------------------  ：     -------------------------------------- 
  path.AddString(pszbuf,          //     String 
                fontFamily,       //              
                0,                //            ,        
                38,               //      Em（    ）      
                MakePoint(10,10), //   Point，            
                strFormat);       //           
  pen := TGPPen.Create(MakeColor(155,215,215,215),3);  //  、   
  graphics.DrawPath(pen,path);    //    GraphicsPath 
  linGrBrush := TGPLinearGradientBrush.Create(MakePoint(0,0),    //        
                                                MakePoint(0,90), //        
                                                MakeColor(255,255,255,255), //        
                                                MakeColor(255,30,120,195)); //        
  linGrBrushW := TGPLinearGradientBrush.Create(MakePoint(0,10), 
                                                MakePoint(0,60), 
                                                MakeColor(255,255,255,255), 
                                                MakeColor(15,1,1,1)); 
  //---------------------  ：      -------------------------------------- 
  for i := 1 to 8 do 
  begin 
    pen.SetWidth(i); 
    pen.SetColor(MakeColor(62, 0, 2, 2)); 
    pen.SetLineJoin(LineJoinRound); //      。               。 
    graphics.DrawPath(pen,path); 
  end; 
  //---------------------  ：        ---------------------------------- 
  if bBack then 
  begin 
    brush := TGPSolidBrush.Create(MakeColor(25,228,228,228)); 
    pen1 := TGPPen.Create(MakeColor(155,223,223,223)); 
    pen2 := TGPPen.Create(MakeColor(55,223,223,223)); 
    image := TGPImage.Create('back.png');             //     
    graphics.FillRectangle(brush,3,5,750,90);         //       
    graphics.DrawRectangle(pen1,2,6,751,91);          //      
    graphics.DrawRectangle(pen2,1,5,753,93);          //      
    graphics.DrawImage(image,600,25); 
  end; 
  //---------------------  ：        GraphicsPath  ----------------- 
  graphics.FillPath(linGrBrush,path); 
  graphics.FillPath(linGrBrushW,path); 
  sizeWindow.cx := 755; 
  sizeWindow.cy := 350; 
  ptSrc := Point(0,0); 
  //---------------------  ：            ，  ，  ，       --- 
  Result := UpdateLayeredWindow(Self.Handle,   //        
                                hdcScreen,     //   DC   
                                @ptWinPos,     //           
                                @sizeWindow,   //         
                                m_hdcMemory,   //           DC   
                                @ptSrc,        //              
                                0,             //                
                                @blend,        //                
                                ULW_ALPHA);    //  pblend      
  //---------------------  ：     -------------------------------------- 
  ReleaseDC(Self.Handle,hdcScreen); 
  ReleaseDC(Self.Handle,hdcTemp); 
  DeleteObject(hBitMap); 
  DeleteDC(m_hdcMemory); 
end; 
{------------------------------------------------------------------------------- 
    :              
-------------------------------------------------------------------------------} 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  //       
  SetWindowLong(Application.Handle, 
                GWL_EXSTYLE, 
                GetWindowLong(Application.Handle,GWL_EXSTYLE) 
                or WS_EX_TOOLWINDOW);   //        
  SetWindowLong(Self.Handle, 
                GWL_EXSTYLE, 
                GetWindowLong(Self.Handle,GWL_EXSTYLE) 
                or WS_EX_LAYERED       //     
                or WS_EX_TOOLWINDOW);  //  alt+tab    
  //        
  m_kind := 0; 
  m_bBack := False; 
  PopupMenu := pm1; 
  Self.Cursor := crHandPoint; 
  mni_topMost.Checked := True; 
  mni_topMostClick(mni_topMost); 

  m_pszbuf[0] := '   Everyone!'; 
  m_pszbuf[1] := '  GDI+       !'; 
  m_pszbuf[2] := '        !'; 
  m_pszbuf[3] := 'http://blog.csdn.net/akof1314!'; 
  m_pszbuf[4] := '          !'; 
  UpdateDisplay(m_pszbuf[m_kind],m_bBack); 
end; 
{------------------------------------------------------------------------------- 
    :               
-------------------------------------------------------------------------------} 
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; 
  Shift: TShiftState; X, Y: Integer); 
begin 
  ReleaseCapture; 
  SendMessage(Self.Handle,WM_SYSCOMMAND,SC_MOVE or HTCAPTION,0); 
end; 
{------------------------------------------------------------------------------- 
    :             
-------------------------------------------------------------------------------} 
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, 
  Y: Integer); 
var 
  xh: TTrackMouseEvent; 
begin 
  m_bBack := True; 
  UpdateDisplay(m_pszbuf[m_kind],m_bBack); 
  with xh do 
  begin 
    cbSize := SizeOf(xh); 
    dwFlags := TME_LEAVE; 
    hwndTrack := Self.Handle; 
    dwHoverTime := 0; 
  end; 
  TrackMouseEvent(xh); 
end; 
{------------------------------------------------------------------------------- 
    :             ，     
-------------------------------------------------------------------------------} 
procedure TForm1.MouseLeave(var Msg: TMessage); 
begin 
  m_bBack := False; 
  UpdateDisplay(m_pszbuf[m_kind],m_bBack); 
  Msg.Result := 0; 
end; 
{------------------------------------------------------------------------------- 
    :               
-------------------------------------------------------------------------------} 
procedure TForm1.tmr1Timer(Sender: TObject); 
begin 
  Inc(m_Kind); 
  if m_kind > 4 then 
    m_kind := 0; 
  UpdateDisplay(m_pszbuf[m_kind],m_bBack); 
end; 
{------------------------------------------------------------------------------- 
    :           
-------------------------------------------------------------------------------} 
procedure TForm1.mni_topMostClick(Sender: TObject); 
begin 
  if mni_topMost.Checked then 
  SetWindowPos(Self.Handle, 
               HWND_TOPMOST, 
               0,0,0,0, 
               SWP_NOSIZE or SWP_NOMOVE)    //     
  else 
  SetWindowPos(Self.Handle, 
               HWND_NOTOPMOST, 
               0,0,0,0, 
               SWP_NOSIZE or SWP_NOMOVE);    //     
end; 
{------------------------------------------------------------------------------- 
    :           （       ） 
-------------------------------------------------------------------------------} 
procedure TForm1.mni_transparentClick(Sender: TObject); 
begin 
  SetWindowLong(Self.Handle, 
                GWL_EXSTYLE, 
                GetWindowLong(Self.Handle,GWL_EXSTYLE) or WS_EX_TRANSPARENT); 
  Application.MessageBox('         ，          ', 
                        '  ',MB_OK or MB_ICONINFORMATION); 
end; 
{------------------------------------------------------------------------------- 
    :         
-------------------------------------------------------------------------------} 
procedure TForm1.mni_exitClick(Sender: TObject); 
begin 
  Self.Close; 
end;