Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Основная";
Текущий архив: 2002.07.15;
Скачать: [xml.tar.bz2];

Вниз

Изображение 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;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.47 MB
Время: 0.013 c
1-47245
Kolya
2002-06-28 04:11
2002.07.15
Как узнать файлы в папке? (Дубль 367)


1-47393
GrayFox
2002-07-01 19:02
2002.07.15
Работа с списками контактов в ICQ


3-47147
Blunder
2002-06-25 07:16
2002.07.15
Выполнение SQL скриптов из приложения


7-47850
Doom
2002-04-24 16:28
2002.07.15
как прописать автозагрузку в WIN.INI?


1-47242
Ulikoff
2002-06-27 11:15
2002.07.15
Тип данных Word и Integer





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
Английский Французский Немецкий Итальянский Португальский Русский Испанский