IRCForumları - IRC ve mIRC Kullanıcılarının Buluşma Noktası

IRCForumları - IRC ve mIRC Kullanıcılarının Buluşma Noktası (https://www.ircforumlari.net/)
-   Delphi (https://www.ircforumlari.net/delphi/)
-   -   Delphide transform form: Pratik Öneriler (https://www.ircforumlari.net/delphi/689093-delphide-transform-form-pratik-oneriler.html)

Kaf_Dağı 16 Mart 2015 10:17

Delphide transform form: Pratik Öneriler
 
Delphide transform form: Pratik Öneriler


Kod:

In the previous article we discussed about using of Windows 2000 function SetLayeredWindowAttributes for
creating transparent forms in Delphi.
 
const
WS_EX_LAYERED = $80000;
LWA_COLORKEY = 1;
LWA_ALPHA = 2;
 
type
TSetLayeredWindowAttributes = function (
    hwnd : HWND; // handle to the layered window
    crKey : TColor; // specifies the color key
    bAlpha : byte; // value for the blend function
    dwFlags : DWORD // action
    ): BOOL; stdcall;
 
Now I would like to talk about practical using of the layered windows.
 
Tip N1: Capturing screen
 
If you will try to capture the screen to bitmap using BitBlt function and have a layered (transparent)  window visible, you will get only a picture of the screen without this window.
To fix it we have to use the new raster-operation code for BitBlt function CAPTUREBLT that introduced in Windows 2000 for including any windows that are layered on top of your window in the resulting image.
 
procedure CaptureScreen(AFileName : string);
const
 CAPTUREBLT = $40000000;
var
 hdcScreen : HDC;
 hdcCompatible : HDC;
 bmp : TBitmap;
 hbmScreen : HBITMAP;
begin
// Create a normal DC and a memory DC for the entire screen. The
// normal DC provides a "snapshot" of the screen contents. The
// memory DC keeps a copy of this "snapshot" in the associated
// bitmap.
 
hdcScreen := CreateDC('DISPLAY', nil, nil, nil);
hdcCompatible := CreateCompatibleDC(hdcScreen);
// Create a compatible bitmap for hdcScreen.
 
hbmScreen := CreateCompatibleBitmap(hdcScreen,
                    GetDeviceCaps(hdcScreen, HORZRES),
                    GetDeviceCaps(hdcScreen, VERTRES));
 
// Select the bitmaps into the compatible DC.
SelectObject(hdcCompatible, hbmScreen);
bmp := TBitmap.Create;
bmp.Handle := hbmScreen;
BitBlt(hdcCompatible,
              0,0,
              bmp.Width, bmp.Height,
              hdcScreen,
              0,0,
              SRCCOPY OR CAPTUREBLT);
 
bmp.SaveToFile(AFileName);
bmp.Free;
DeleteDC(hdcScreen);
DeleteDC(hdcCompatible);
end;
 
 
 
Tip N2: Transparent external program
 
OK, before we made our own forms transparent, but what about making external programs like Notepad transparent also? Yes, it's also possible.
 
 
 
First, we will start Notepad using ShellExecute function
 
ShellExecute(Application.Handle,'open','notepad.exe',nil,nil,SW_SHOW);
 
and after will make it transparent.
 
procedure ShowTransparentNotepad;
var
 np:HWND;
begin
 np:=FindWindow('Notepad',nil);
 SetTransparentForm(np,100);
end;
 
The code of the SetTransparentForm procedure you can find in article Transparent Forms in Delphi 5 and 6
 
 
Tip N3: Transparent Hint
 
For customizing the standard Delphi hint window  we have to override THintWindow class. After overriding THintWindow to create a new derived type TTransparentHint, we will assign the new type to the global HintWindowClass variable at application startup, so that the new transparent hint window type is used for Help Hints.
 
type
TTransparentHint = class(THintWindow)
private
  FTransparency : byte;
protected
  procedure CreateParams(var Params: TCreateParams); override;
  procedure CreateWnd; override;
public
  property Transparency : byte read FTransparency write FTransparency;
  constructor Create(AOwner : TComponent); override;
end;
 
{ TTransparentHint }
 
constructor TTransparentHint.Create(AOwner: TComponent);
begin
 inherited;
 FTransparency := 100;
end;
 
procedure TTransparentHint.CreateParams(var Params: TCreateParams);
begin
 inherited;
 Params.ExStyle := Params.ExStyle or WS_EX_LAYERED;
end;
 
procedure TTransparentHint.CreateWnd;
var
SetLayeredWindowAttributes: TSetLayeredWindowAttributes;
begin
 inherited;
 SetLayeredWindowAttributes :=
 GetProcAddress(GetModulehandle(user32), 'SetLayeredWindowAttributes');
SetLayeredWindowAttributes(Handle, 0, FTransparency, LWA_ALPHA);
end;
 
Now we have to assign TTransparentHint to the HintWindowClass variable at application startup.
 
procedure TForm1.FormCreate(Sender: TObject);
begin
 HintWindowClass := TTransparentHint;
end;



Tüm Zamanlar GMT +3 Olarak Ayarlanmış. Şuanki Zaman: 05:59.

Powered by vBulletin® Version 3.8.8 Beta 3
Copyright ©2000 - 2024, vBulletin Solutions, Inc.
Search Engine Friendly URLs by vBSEO
Copyright ©2004 - 2024 IRCForumlari.Net