자료실 자료를 이용해서

변형을 시켜서 구현은 해 보았습니다.





첫번재 궁금 한점



한면을 전체를 읽지안고 반투명 하게 보이려는 폼 크기만큼만

읽어서 표현하는 방법이 없는지 궁금하고요..





두번재



말그대로

투명이라는 이미지 대로 밑에보이는 (만약 시간이 돌고 있다면) 데이타가

변화가 있다면

반투명 창에서 보이게 할 방법이 없는지요..









밑에 짜집기소스 입니다..



unit MGlass;



interface



uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

ExtCtrls;



type

THoundred = 0..100;



PRGBArray = ^TRGBArray;

TRGBArray = Array[0..1000000] of TRGBTriple;



TMGlass = class(TPaintBox)

private

{ Private declarations }





FMoveable: Boolean;

FTranspColor: TColor;

FTransparency: THoundred;

ScreenShoot: TBitmap;

ParentForm: TForm;

PrevParentWndProc: Pointer;

CanTakeScreen: Boolean;

procedure TakeScreenShoot;

procedure SetTranspColor(Value: TColor);

procedure SetTransparency(Value: THoundred);

procedure WMEraseBkgnd(var m: TMessage);

protected

{ Protected declarations }

procedure NewParentWndProc(var Msg: TMessage);

public

{ Public declarations }

constructor Create(aOwner: TComponent); override;

destructor Destroy; override;

procedure Loaded; override;



procedure Paint; override;

published

{ Published declarations }

property Moveable: Boolean read FMoveable write FMoveable;

property TranspColor: TColor read FTranspColor write SetTranspColor;

property Transparency: THoundred read FTransparency write SetTransparency;



end;



procedure Register;



implementation

var IgnoreMessage : Boolean;





constructor TMGlass.Create(aOwner: TComponent);

var

p: Pointer;

begin

inherited Create(aOwner);

ParentForm := TForm(aOwner);

FMoveable := True;

FTransparency := 60;

FTranspColor := clBlack;

ScreenShoot := TBitmap.Create;

Align:=alClient;

ParentForm.BorderStyle:= bsDialog;



SetWindowLong(ParentForm.Handle,GWL_STYLE,

GetWindowLong(ParentForm.Handle,GWL_STYLE) and not WS_CAPTION);

ParentForm.Height := ParentForm.ClientHeight;





PrevParentWndProc := Pointer(GetWindowLong(ParentForm.Handle, GWL_WNDPROC));

p := MakeObjectInstance(NewParentWndProc);

SetWindowLong(ParentForm.Handle, GWL_WNDPROC, LongInt(p));













CanTakeScreen := True;

end;



procedure TMGlass.WMEraseBkgnd(var m: TMessage);

begin

m.Result := 1;

end;



procedure TMGlass.Loaded;

begin

inherited Loaded;

TakeScreenShoot;

end;



destructor TMGlass.Destroy;

begin

if ScreenShoot <> nil then ScreenShoot.Destroy;

inherited Destroy;

end;









//******************************************************************************

//******************************************************************************



procedure TMGlass.NewParentWndProc(var Msg: TMessage);

begin

Msg.Result :=CallWindowProc(PrevParentWndProc, ParentForm.Handle, Msg.Msg,

Msg.WParam, Msg.LParam);





case Msg.Msg of

wm_Activate: if (Lo(Msg.wParam) <> wa_Inactive) and

CanTakeScreen then TakeScreenShoot;

wm_Move :begin

Paint;

end;



// wm_NCHitTest: if not (csDesigning in ComponentState) and

// FMoveable and (Msg.Result = htClient) then

// Msg.Result := htCaption

end;



end;





procedure TMGlass.TakeScreenShoot;

var

DC: hDC; // DesktopDC

ScreenWidth, ScreenHeight: Integer;

SL: PRGBArray;

X, Y: Integer;

begin

if (csDesigning in ComponentState) or (ScreenShoot = nil) then Exit;



CanTakeScreen := False;



ScreenWidth := GetSystemMetrics(sm_CXScreen);

ScreenHeight := GetSystemMetrics(sm_CYScreen);



ScreenShoot.Width := ScreenWidth;

ScreenShoot.Height := ScreenHeight;

ScreenShoot.PixelFormat := pf24bit;



IgnoreMessage:=True;

if ParentForm.Visible then

ShowWindow(ParentForm.Handle, SW_Hide);



IgnoreMessage:=True;

SetActiveWindow(0);



// Sleep(0);

DC := GetDC(0);

BitBlt(ScreenShoot.Canvas.Handle,0,0,

ScreenWidth, ScreenHeight, DC,0,0,SrcCopy);



ReleaseDC(0, DC);



for Y := 0 to ScreenHeight - 1 do

begin

SL := ScreenShoot.ScanLine[Y];

for X := 0 to ScreenWidth - 1 do

begin

try

SL[X].rgbtRed := (FTransparency * SL[X].rgbtRed + (100 - FTransparency) * GetRValue(FTranspColor)) div 100;

SL[X].rgbtGreen := (FTransparency * SL[X].rgbtGreen + (100 - FTransparency)* GetGValue(FTranspColor)) div 100;

SL[X].rgbtBlue := (FTransparency * SL[X].rgbtBlue + (100 - FTransparency) * GetBValue(FTranspColor)) div 100;

except

end;

end

end;



IgnoreMessage:=True;

if ParentForm.Visible then

ShowWindow(ParentForm.Handle, sw_Show);



SetActiveWindow(0);

end;





procedure TMGlass.Paint;

var

X, Y: Integer;



begin

inherited Paint;

x:=ParentForm.Left+3;

y:=ParentForm.Top+3;



BitBlt(Canvas.Handle,0,0, ScreenShoot.Width,ScreenShoot.Height,

ScreenShoot.Canvas.Handle,

x,y,SRCCOPY);

end;



procedure TMGlass.SetTranspColor(Value: TColor);

begin

if FTranspColor <> Value then

begin

FTranspColor := Value;

if ScreenShoot <> nil then

begin

TakeScreenShoot;

Paint;

end;

end;

end;



procedure TMGlass.SetTransparency(Value: THoundred);

begin

if FTransparency <> Value then

begin

FTransparency := Value;

if ScreenShoot <> nil then

begin

TakeScreenShoot;

Paint;

end;

end;

end;







procedure Register;

begin

RegisterComponents('MSoft_Component', [TMGlass]);

end;



end.