Главная страница
    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.47 MB
Время: 0.011 c
6-47624
Konsul
2002-04-28 14:20
2002.07.15
Звук через локальную сеть


1-47361
CA
2002-06-30 12:57
2002.07.15
Параметр


3-47175
fool
2002-06-19 12:14
2002.07.15
Ошибки по русски,про Oracle слышал, а MSSQL?


7-47816
Ezh
2002-04-19 12:18
2002.07.15
Печать из StringGrid


14-47739
Guru
2002-06-11 12:16
2002.07.15
Что такое Delphi ?





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский