Форум: "Основная";
Текущий архив: 2002.12.09;
Скачать: [xml.tar.bz2];

Вниз

MDI форма   Найти похожие ветки 

← →
Term   (2002-11-27 11:26) [0]

Подскажите как поместить image на mdi форму

---

← →
Игорь Шевченко   (2002-11-27 12:11) [1]

К примеру так:

unit main;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ActnList, Menus, jpeg, ExtCtrls, ComCtrls;

type
TForm1 = class(TForm)
ActionList1: TActionList;
MainMenu1: TMainMenu;
actClose: TAction;
StatusBar1: TStatusBar;
N1: TMenuItem;
N2: TMenuItem;
Image1: TImage;
actTest: TAction;
N3: TMenuItem;
actTest1: TMenuItem;
procedure actCloseExecute(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure actTestExecute(Sender: TObject);
private
{ Private declarations }
FClientInstance : TFarProc;
FPrevClientProc : TFarProc;
procedure ClientWndProc(var Message: TMessage);
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation
uses Test;

{$R *.DFM}

procedure TForm1.ClientWndProc(var Message: TMessage);
var
Dc : hDC;
Row : Integer;
Col : Integer;
begin
if (Image1.Picture.Width = 0) OR (Image1.Picture.Height = 0) then begin
with Message do
Result := CallWindowProc(FPrevClientProc,
ClientHandle,
Msg,
wParam,
lParam);
Exit;
end else
with Message do
case Msg of
WM_ERASEBKGND:
begin
Dc := TWMEraseBkGnd(Message).Dc;
for Row := 0 to ClientHeight div Image1.Picture.Height do
for Col := 0 to ClientWidth div Image1.Picture.Width do
BitBlt(Dc,
Col * Image1.Picture.Width,
Row * Image1.Picture.Height,
Image1.Picture.Width,
Image1.Picture.Height,
Image1.Picture.Bitmap.Canvas.Handle,
0,0,SRCCOPY);
Result := 1;
end;
else
Result := CallWindowProc(FPrevClientProc,
ClientHandle,
Msg,
wParam,
lParam);
end;
end;

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

procedure TForm1.FormCreate(Sender: TObject);
begin
FClientInstance := MakeObjectInstance(ClientWndProc);
FPrevClientProc := Pointer(GetWindowLong(ClientHandle,
GWL_WNDPROC));
SetWindowLong(ClientHandle,
GWL_WNDPROC, LongInt(FClientInstance));
end;

procedure TForm1.actTestExecute(Sender: TObject);
begin
with TfrmTest.Create(Application) do
Show();
end;

end.


---

← →
Term   (2002-11-28 11:00) [2]

спасибо
попробую

---

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

Форум: "Основная";
Текущий архив: 2002.12.09;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.44 MB
Время: 0.009 c