Мастера DELPHI (документация, исходники, скачать)

Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

Как правильно скопировать изображение одной формы в другую

Elen © (2007-08-13 11:31:00)
Есть две формы. Я хочу чтоб фон второй формы показывал изображение первой формы. т.е. делаю так :

BitBlt(Canvas.Handle,0,0,Width,Height,form1.Canvas.Handle,0,0,SRCCOPY);

Но если вторая форма перекрывает первую, то и в изображении я получаю перекрытие.

Вопрос: Можно ли и как правильно закрасить одну форму изображением другой?

Elen (2007-08-13 14:39:00) [1]
О-о-о. так вот где собака порылась!!! Спасибо, вот уж не ожидала что дело в AlphaBlend'e. Вот это уже стоящее. Еще раз спасибо. $)

{RASkov} (2007-08-13 14:31:00) [2]
> [10] Elen © (13.08.07 13:51)

Впрочем сейчас попробывал....
Накидал на первую(Form1) всяких разных конролов. Добавил вторую и изменил одно свойство AlphaBlend = True, а AlphaBlendValue оставил 255
и код из [0] все прекрасно работает. Может и не стоит парится с WM_NCPAINT и WM_ERASEBKGND? :)

Elen (2007-08-13 13:51:00) [3]

> {RASkov} © (13.08.07 13:21) [9]
Это что? :)

Skype аналог Аськи.

Пасибо за примерчик. Может чего путного и выйдет, но сдается мне что придется порулить в сторону WM_NCPAINT и WM_ERASEBKGND.

{RASkov} (2007-08-13 13:21:00) [4]
> [8] Elen © (13.08.07 13:15)
> У меня только Скайп.

Это что? :)

Посмотрел... он вообще маленький оказался, вот весь здесь:
DFM
object Form1: TForm1 Left = 361 Top = 104 Cursor = crSizeAll AlphaBlend = True BorderStyle = bsNone Caption = 'Form1' ClientHeight = 200 ClientWidth = 200 Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'MS Sans Serif' Font.Style = [] FormStyle = fsStayOnTop OldCreateOrder = False Position = poScreenCenter OnCreate = FormCreate OnDestroy = FormDestroy OnMouseDown = FormMouseDown OnMouseUp = FormMouseUp OnMouseWheelDown = FormMouseWheelDown OnMouseWheelUp = FormMouseWheelUp PixelsPerInch = 96 TextHeight = 13 object Timer1: TTimer Interval = 1 OnTimer = Timer1Timer end end
PAS:
unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, RXCtrls; type TForm1 = class(TForm) Timer1: TTimer; procedure FormCreate(Sender: TObject); procedure Timer1Timer(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure FormMouseWheelDown(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); procedure FormMouseWheelUp(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); private procedure FMv(var Ms: TMessage); message WM_MOVE; procedure Uvelichenie; { Private declarations } public { Public declarations } end; var Form1: TForm1; DC: HDC; BMP, BMPBIG: TBitMap; xU, xX, XT, Uk, XC, YC: Integer; FMove: Boolean=False; implementation {$R *.dfm} procedure SetUvelich(const U: Byte); begin xU:=U*100; xX:=-(xU div 2); BMPBIG.Height:=Form1.Height+xU; BMPBIG.Width:=Form1.Width+xU; Form1.Uvelichenie; end; procedure TForm1.FormCreate(Sender: TObject); var FRGN: HRGN; begin Height:=200; Width:=200; XC:=Width div 2; YC:=Height div 2; FRGN:=CreateEllipticRgn(0, 0, Width, Height); try SetWindowRgn(Handle, FRGN, True); DoubleBuffered:=True; Canvas.Font.Style:=[fsBold]; Canvas.Pen.Color:=clAqua; Canvas.Pen.Width:=2; BMP:=TBitMap.Create; BMP.Height:=Screen.Height; BMP.Width:=Screen.Width; BMPBIG:=TBitmap.Create; Uk:=5; SetUvelich(Uk); Canvas.Brush.Style:=bsClear; DC:=GetDC(0); finally DeleteObject(FRGN); end; end; procedure TForm1.Uvelichenie; var S: String; begin if DC=0 then Exit; try BitBlt(BMP.Canvas.Handle, 0, 0, Width, Height, DC, ClientOrigin.X, ClientOrigin.Y, SRCCOPY); BMPBIG.Canvas.CopyRect(Rect(0, 0, 200+xU, 200+xU), BMP.Canvas, Rect(0, 0, 200, 200)); Canvas.Draw(xX, xX, BMPBIG); Canvas.Ellipse(1, 1, Width-2, Height-2); if FMove then begin Canvas.Font.Color:=Canvas.Pixels[XC, 12] xor $FFFFFF; if Uk=0 then S:='no' else if Uk=15 then S:='max' else S:='x'+IntToStr(Uk); XT:=XC-Canvas.TextWidth(S) div 2; Canvas.TextOut(XT, 5, S); Canvas.Pen.Width:=1; Canvas.Pen.Color:=Canvas.Pixels[XC-4, YC] xor $FFFFFF; Canvas.MoveTo(XC-3, YC); Canvas.LineTo(XC-6, YC); Canvas.Pen.Color:=Canvas.Pixels[XC+4, YC] xor $FFFFFF; Canvas.MoveTo(XC+3, YC); Canvas.LineTo(XC+6, YC); Canvas.Pen.Color:=Canvas.Pixels[XC, YC-4] xor $FFFFFF; Canvas.MoveTo(XC, YC-3); Canvas.LineTo(XC, YC-6); Canvas.Pen.Color:=Canvas.Pixels[XC, YC+4] xor $FFFFFF; Canvas.MoveTo(XC, YC+3); Canvas.LineTo(XC, YC+6); Canvas.Pen.Color:=clAqua; Canvas.Pen.Width:=2; end; except end; end; procedure TForm1.FMv(var Ms: TMessage); begin Uvelichenie; end; procedure TForm1.Timer1Timer(Sender: TObject); begin Uvelichenie; Timer1.Interval:=700; FMove:=(GetAsyncKeyState(VK_LBUTTON)<>0); end; procedure TForm1.FormMouseWheelDown(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); begin if Uk<1 then Exit else DEC(Uk); FMove:=True; SetUvelich(Uk); end; procedure TForm1.FormMouseWheelUp(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); begin if Uk>14 then Exit else INC(Uk); FMove:=True; SetUvelich(Uk); end; procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if Button=mbLeft then begin ReleaseCapture; Perform(WM_SYSCOMMAND, $F012, 0); end; end; procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if Button=mbRight then Close; end; procedure TForm1.FormDestroy(Sender: TObject); begin BMP.Free; BMPBIG.Free; ReleaseDC(0, DC); end; end.

Elen (2007-08-13 13:15:00) [5]

> {RASkov} © (13.08.07 13:13) [7]

У меня только Скайп. Ты выложи основные принципы если не трудно.

{RASkov} (2007-08-13 13:13:00) [6]
> [6] Elen © (13.08.07 12:56)

Я делал некое подобие "увеличилки", могу кинуть проект.... он не большой, но может из него найдешь ответ на свой вопрос.
Впрочем так же задавал вопрос здесь, но это было относительно давно....
Только скажи куда кидать :)

Elen (2007-08-13 12:56:00) [7]
XP

{RASkov} (2007-08-13 12:37:00) [8]
> [0] Elen © (13.08.07 11:31)

Под какую Win?

Elen (2007-08-13 11:53:00) [9]
Ладно допустим, а если я хочу такое провернуть с компонентами на одной форме, мне что нужно один компонент скрывать, делать снапшот, потом показывать компонент и заливать его полученным снапшотом?

DVM (2007-08-13 11:42:00) [10]

> Не выходит. Все равно перекрытие видно.

Надо подождать пока она перерисуется. Или вызвать ее метод Repaint;

Elen (2007-08-13 11:38:00) [11]
Form1.BringToFront; BitBlt(Canvas.Handle,0,0,Width,Height,form1.Canvas.Handle,0,0,SRCCOPY); Form1.SendToBack

Не выходит. Все равно перекрытие видно.

DVM (2007-08-13 11:33:00) [12]

> Можно ли и как правильно закрасить одну форму изображением
> другой?

Форму с которой снимается снапшот надо на время отобразить сверху, потом убрать.

Наверх

	« предыдущая ветвь \| форум \| следующая ветвь »