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.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;
来自: 卷起千堆雪tyn, 时间: 2001-04-19 23:11:00, ID: 509911 transparent form ? 哈哈...我为你做好了，你参考吧. {Add a button to a form and try this:} procedure TForm1.FormCreate(Sender: TObject); var FullRgn, ClientRgn, ButtonRgn: THandle; Margin, X, Y: Integer; begin Margin := (Width - ClientWidth) div 2; FullRgn := CreateRectRgn(0, 0, Width, Height); X := Margin; Y := Height - ClientHeight - Margin; ClientRgn := CreateRectRgn(X, Y, X + ClientWidth, Y + ClientHeight); CombineRgn(FullRgn, FullRgn, ClientRgn, RGN_DIFF); X := X + Button1.Left; Y := Y + Button1.Top; ButtonRgn := CreateRectRgn(X, Y, X + Button1.Width, Y + Button1.Height); CombineRgn(FullRgn, FullRgn, ButtonRgn, RGN_OR); SetWindowRgn(Handle, FullRgn, True); end;
来自: tonylk, 时间: 2001-04-23 12:27:00, ID: 514375 我做了个小程序，有你类似的功能：以下是部分代码： procedure TSprite.SaveBackGround(); var SC:TCanvas; begin SetWindowPos(FormMain.Handle,HWND_BOTTOM,FormMain.Left,FormMain.Top,FormMain.Width,FormMain.Height,SWP_HIDEWINDOW); SC:=TCanvas.Create; try SC.Handle:=GetDC(0); FOldBmp.Canvas.CopyRect(Rect(0,0,SPWIDTH,SPHEIGHT),SC,Rect(FPosition.X,FPosition.Y,FPosition.X+SPWIDTH,FPosition.Y+SPHEIGHT)); FNewBmp.Assign(FOldBmp); ReleaseDC(0,Sc.Handle); finally SC.Free; end; FormMain.Canvas.Draw(0,0,FOldBmp);//this line here let the form be transparent when the form create SetWindowPos(FormMain.Handle,HWND_TOPMOST,FormMain.Left,FormMain.Top,FormMain.Width,FormMain.Height,SWP_NOMOVE+SWP_SHOWWINDOW); end;
procedure TSprite.Paint(X,Y:integer;Image:TBitmap); function XslateRect(R:Trect;X,Y:integer):TRect; begin with R do Result:=Rect(Left-X,Top-Y,Right-X,Bottom-Y); end;//XslateRect(R:Trect;X,Y:integer):TRect; var SC:TCanvas; OrgRect,OldRect,NewRect,TmpRect:TRect; OldRgn,NewRgn,TmpRgn:HRgn; TmpWindow:Hwnd; begin OrgRect:=Rect(0,0,SPWIDTH,SPHEIGHT); OldRect:=Rect(FPosition.X,FPosition.Y,FPosition.X+SPWIDTH,FPosition.Y+SPHEIGHT); NewRect:=Rect(X,Y,X+SPWIDTH,Y+SPHEIGHT);
TmpWindow:=GetForeGroundWindow(); if (TopWindow<>TmpWindow) and (TmpWindow<>FormMain.Handle) and (TmpWindow<>Application.Handle) then begin SaveBackground(); TopWindow:=TmpWindow; end;
来自: ZhuHongQing, 时间: 2001-05-19 2:25:00, ID: 535898 用这个就行： function Tform1.CreateRegion(wMask:TBitmap;wColor:TColor;hControl:THandle): HRGN; var dc, dc_c: HDC; rgn: HRGN; x, y: integer; coord: TPoint; line: boolean; color: TColor; begin dc := GetWindowDC(hControl); dc_c := CreateCompatibleDC(dc); SelectObject(dc_c, wMask.Handle); BeginPath(dc); for x:=0 to wMask.Width-1 do begin line := false; for y:=0 to wMask.Height-1 do begin color := GetPixel(dc_c, x, y); if not (color = wColor) then begin if not line then begin line := true; coord.x := x; coord.y := y; end; end; if (color = wColor) or (y=wMask.Height-1) then begin if line then begin line := false; MoveToEx(dc, coord.x, coord.y, nil); LineTo(dc, coord.x, y); LineTo(dc, coord.x + 1, y); LineTo(dc, coord.x + 1, coord.y); CloseFigure(dc); end; end; end; end; EndPath(dc); rgn := PathToRegion(dc); ReleaseDC(hControl, dc); Result := rgn; end;
procedure TForm1.FormCreate(Sender: TObject); var w1:TBitmap; w2:TColor; rgn: HRGN; begin w1:=TBitmap.Create; w1.Assign(image1.Picture); w2:=w1.Canvas.Pixels[0,0]; rgn := CreateRegion(w1,w2,Handle); if rgn<>0 then begin SetWindowRgn(Handle, rgn, true); end; w1.Free;
来自: varphone, 时间: 2001-10-22 16:42:00, ID: 686010 Blend Window require the Windows 2000 or later version! Use the SetWindowLong(..GWL_ALPHA); SetLayeredWindowAttributes(Handle...);
