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

Вниз

Рисование на Canvas Главной MDI Формы   Найти похожие ветки 

← →
xn0bys   (2003-04-11 11:29) [0]

Господа, помогите!
Есть кусок кода:

procedure TfrmMain.FormPaint(Sender: TObject);
var b:TBitmap;
begin

b:=TBitmap.Create;
try
with frmMain.Canvas do
begin
b.LoadFromResourceName(HInstance,"BACK");
Brush.Bitmap:=b;
FillRect(ClientRect);// Rect(2,2,ClientWidth-2,ClientHeight-2));
end;
finally
b.free
end;
end;


Если Form.Style=fsNormal то всё фурычит нормально, а если
Form.Style=fsMDIForm, то он не работает.
Пробовал через HDC, рисует, но событие приходит только при Максимизации окна и при инициализации.
Вопрос, как мне обойти этот глюк!

---

← →
Игорь Шевченко   (2003-04-11 11:35) [1]


TForm1 = class(TForm)
.....
procedure FormCreate(Sender: TObject);
private
FClientInstance : TFarProc;
FPrevClientProc : TFarProc;
procedure ClientWndProc(var Message: TMessage);
....
end;

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.FormCreate(Sender: TObject);
begin
FClientInstance := MakeObjectInstance(ClientWndProc);
FPrevClientProc := Pointer(GetWindowLong(ClientHandle,
GWL_WNDPROC));
SetWindowLong(ClientHandle,
GWL_WNDPROC, LongInt(FClientInstance));
end;




---

← →
icWasya   (2003-04-11 11:49) [2]

type
TMainForm = class(TForm)
Cnv : TCanvas;
.....

.....
procedure TMainForm.OnDestroy(Sender:TObject);
begin
Application.OnMessage :=Nil;
Cnv .Free;
end;

procedure TMainForm.OnCreate(Sender:TObject);
begin
Cnv := TCanvas.Create;
Application.OnMessage := OnMessageProc;
end;


procedure TMainForm.OnMessageProc (var Msg: TMsg; var h: boolean);
begin
if (Msg.Message = WM_PAINT) and (Msg.HWND = ClientHandle) then
FormPaint (self);
end;

procedure TMainForm.FormPaint(Sender: TObject);
var
R: TRect;
Hnd: THandle;
begin
WinProcs.GetClientRect (ClientHandle, R);
Hnd := GetDC (ClientHandle);
try
Cnv.Handle := Hnd;
Cnv.StretchDraw (R, Image1.Picture.Bitmap);
finally
ReleaseDC (ClientHandle, Hnd);
end;
end;

---

← →
xn0bys   (2003-04-11 12:57) [3]

Спасибо всем!
Все работает.

---

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

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

Наверх

Память: 0.45 MB
Время: 0.008 c