Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2002.07.15;
Скачать: CL | DM;

Вниз

Изображение Parent а   Найти похожие ветки 

 
ricks ©   (2002-07-03 17:43) [0]

Помогите пожайлуста.
Мне надо получить изображение под контролом, те скопировать DC его Parent"a. Как мне это лучше сделать. Я написал такой код:

Function ControlParentImage:TBitmap;
var PWnd:HWND;
DC :HDC;
R :TRect;
W, H:Integer;
begin
PWnd:=GetParent(ControlWND);
DC:=GetDC(PWnd);
GetWindowRect(ControlWND, R);
W:=R.Right-R.Left;
H:=R.Bottom-R.Top;
ScreenToClient(PWnd, R.TopLeft);
Result:=TBitmap.Create;
Result.Handle:=CreateCompatibleBitmap(DC, W, H);
try
ShowWindow(ControlWND, SW_HIDE);
RedrawWindow(PWnd, nil, 0, RDW_INVALIDATE or RDW_UPDATENOW);
BitBlt(Result.Canvas.Handle, 0, 0, W, H, DC, R.Left, R.Top, SRCCOPY);
ShowWindow(ControlWND, SW_SHOW);
finally
ReleaseDC(ControlWND, DC);
end;
end;

Но при больших Control"ах они начинают мигать. Может кто знает, как мне лучше это сделать???


 
Fiend ©   (2002-07-03 17:48) [1]

аможет нада ControlWND.Parent использовать, и не скрывать дочерние объекты


 
Fiend ©   (2002-07-03 17:50) [2]

У меня в юности был таой код

procedure TTransparator.DoTransparent;
var
X, Y : Integer;
begin
{ Pt.X := TImage(Dest).left;
Pt.Y := TImage(Dest).top;}
X := TForm(owner).left+(TForm(owner).Width-TForm(owner).ClientWidth)div 2+TImage(Dest).left;
Y :=TForm(owner).height-TForm(owner).ClientHeight-(TForm(owner).width-TForm(owner).Clientwidth)div 2 +TForm(owner).top+TImage(dest).top;
{TForm(owner).visible := false;}
DesktopHWnd := GetDesktopWindow;
DesktopDC := GetDC(DesktopHWnd);
BitBlt(TImage(Dest).Canvas.Handle, 0,0,TImage(Dest).width,TImage(Dest).Height,
DesktopDC,X,Y, SRCCOPY);
TImage(Dest).refresh;
ReleaseDC(DesktopHWnd, DesktopDC);
{TForm(owner).visible := true;}
end;


 
ricks ©   (2002-07-03 17:58) [3]

->а может нада ControlWND.Parent использовать
Я забыл указать, что ControlWND - это HWND, а не Control, и потом, если не скрывать дочерние окна, то вместо изображения Parent"a как раз будет это дочернее окно


 
Fiend ©   (2002-07-03 18:04) [4]

от я когда то делал прозрачную фишку, гляньте:
unit Mymrr1;

interface

uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, ExtCtrls, StdCtrls, Buttons, ClipBrd;

type
TForm1 = class(TForm)
Image1: TImage;
Label2: TLabel;
spdButCopyToClipboard: TSpeedButton;
spdButExit: TSpeedButton;
Label1: TLabel;

procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormCreate(Sender: TObject);
procedure spdButExitClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure spdButCopyToClipboardClick(Sender: TObject);
procedure FormPaint(Sender: TObject);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
private
{ Private declarations }
DesktopHWnd: HWnd;
DesktopDC: HDc;
MyRec,DesktopRect: TRect;
XSrc,YSrc : integer;
MouseCaptured : boolean;

public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if (not MouseCaptured) and (Button = mbLeft)then begin
label2.caption := "Down";
{label1.visible := False;
spdButExit.visible := False;
spdButCopyToClipboard.visible := False;}
MouseCaptured := True;
SetCapture(Handle);
DesktopHWnd := GetDesktopWindow;
DesktopDC := GetDC(DesktopHWnd);
end;
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if MouseCaptured then begin
{label1.caption := IntToStr(x)+","+IntToStr(y);}
BitBlt(Image1.Canvas.Handle, 0,0,Image1.Width,Image1.Height,
DesktopDC, X+Form1.Left, Y+Form1.Top, SRCCOPY);
Image1.Refresh;
end;
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if MouseCaptured and (Button = mbLeft) then begin
label2.caption := "Up";
{ label1.visible := True;
spdButExit.visible := True;
spdButCopyToClipboard.visible := True;}
MouseCaptured := False;
ReleaseCapture;
ReleaseDC(DesktopHWnd, DesktopDC);
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
MouseCaptured := False;
Form1.Visible := False;
DesktopHWnd := GetDesktopWindow;
DesktopDC := GetDC(DesktopHWnd);
BitBlt(Image1.Canvas.Handle, 0,0,Image1.Width,Image1.Height,
DesktopDC, Form1.Left-(Width-ClientWidth), Form1.Top+(Height-ClientHeight), SRCCOPY);
Image1.Refresh;
ReleaseDC(DesktopHWnd, DesktopDC);
Form1.Visible := True;
end;

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

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if MouseCaptured then begin
MouseCaptured := False;
ReleaseCapture;
ReleaseDC(DesktopHWnd, DesktopDC);
end;
end;

procedure TForm1.spdButCopyToClipboardClick(Sender: TObject);
begin
Clipboard.Assign(Image1.Picture);
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
SetCapture(Handle);
DesktopHWnd := GetDesktopWindow;
DesktopDC := GetDC(DesktopHWnd);
BitBlt(Image1.Canvas.Handle, 0,0,Image1.Width,Image1.Height,
DesktopDC,Form1.Left,Form1.Top, SRCCOPY);
Image1.Refresh;
ReleaseCapture;
ReleaseDC(DesktopHWnd, DesktopDC);
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
SetCapture(Handle);
DesktopHWnd := GetDesktopWindow;
DesktopDC := GetDC(DesktopHWnd);
BitBlt(Image1.Canvas.Handle, 0,0,Image1.Width,Image1.Height,
DesktopDC,Form1.Left,Form1.Top, SRCCOPY);
Image1.Refresh;
ReleaseCapture;
ReleaseDC(DesktopHWnd, DesktopDC);

end;

end.


 
ricks ©   (2002-07-03 18:34) [5]

>Fiend
Что-то не работает, может потому что в XP?
А вы для какой писали? (я смотрю там WinTypes, WinProcs)



Страницы: 1 вся ветка

Текущий архив: 2002.07.15;
Скачать: CL | DM;

Наверх




Память: 0.48 MB
Время: 0.015 c
3-47079
Arkady
2002-06-21 09:01
2002.07.15
DBGrid


3-47150
icu
2002-06-18 16:26
2002.07.15
Объединение полей в запросе


1-47570
AlexanderSK
2002-06-27 12:39
2002.07.15
TBDEClientDataSet в Delphi6


6-47639
Sergey_001
2002-05-03 14:52
2002.07.15
У меня к вам два вопроса.


3-47102
RDA
2002-06-21 15:49
2002.07.15
Требуется совет по компонентам доступа к данным базы данных