рисование на канве и сообщения windows

[olchick]

Имеется проблема: Необходимо на форму вывести только часть (300х300 пикселей) изображения, т.е. вырезать нужную часть из рисунка и отобразить ее на канве формы. Для простоты пусть изображение будет храниться в файле 1.jpg. Обязательно нужно выводить на канву формы.
Действую так:

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, jpeg;
Const
WM_draw=WM_USER+1;
type
TForm1 = class(TForm)
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Button1Click(Sender: TObject);
private
procedure mydraw (var mes : TMessage); message WM_draw ;
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
MyRect: TRect;
MyBmp: TBitmap;
MyJpg: TJPEGImage;

implementation

{$R *.dfm}
procedure TForm1.MyDraw(var Mes: TMessage);
begin
Canvas.StretchDraw(MyRect, MyBmp);
InvalidateRect(Handle, @MyRect, FALSE);
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
MyBmp := TBitmap.Create;
MyJpg := TJPEGImage.Create;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
MyBmp.Free;
MyJpg.Free;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
MyJpg.LoadFromFile('1.jpg');
MyBmp.Assign(MyJpg);
SetRect(MyRect, 100, 100, 400, 400);
PostMessage(Handle, WM_draw, 0, 0);
end;

end.


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

В коде используется подход с сообщениями Windows для отрисовки, но это нужно в моей программе с полными функциональными возможностьями.

Помогите устранить возникшую проблему.

[mflat]

Надо код отрисовки поместить в процедуру OnPaint для твоей формы, и тогда проблем не будет.
Тоесть вот так:

procedure TForm1.FormPaint(Sender: TObject);
begin
  SetRect(MyRect, 100, 100, 400, 400);
  PostMessage(Handle, WM_draw, 0, 0);
end;

[olchick]

Сообщение от mflat

Надо код отрисовки поместить в процедуру OnPaint для твоей формы, и тогда проблем не будет.
Тоесть вот так:

procedure TForm1.FormPaint(Sender: TObject);
begin
  SetRect(MyRect, 100, 100, 400, 400);
  PostMessage(Handle, WM_draw, 0, 0);
end;

Все хорошо, но вот появляется проблема - мерцание

[mflat]

Напиши при загрузке формы этот код:
DoubleBuffered := true;

[olchick]

Сообщение от mflat

Напиши при загрузке формы этот код:
DoubleBuffered := true;

Это тоже пробовала - ничего не вышло. Помоему даже хуже стало

[mflat]

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs;
const
  WM_DRAW = WM_USER + 1;
type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
  private
    procedure MyDraw(var msg: TMessage); message WM_DRAW;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  MyRect: TRect;
  MyBmp: TBitmap;
implementation

{$R *.dfm}
procedure TForm1.MyDraw(var Msg: TMessage);
begin
  Canvas.StretchDraw(MyRect, MyBmp);
  InvalidateRect(Handle, @MyRect, False);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  MyBmp := TBitmap.Create;
  MyBmp.LoadFromFile('bmp.bmp');
  SetRect(MyRect, 100, 100, 400, 400);
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
  PostMessage(Form1.Handle, WM_DRAW, 0, 0);
  Sleep(1);
end;

end.

Сказать честно, вы выбрали не совсем хороший метод рисования. Я думаю, этот пример вы использовали как тренировка и получение опыта от различных методов вывода графики. Но лучше выводить картинку по другому.
Насчёт кода. Мелькание происходит только тогда, когда вы перемещаете форму.

[DeKot]

Есть же простой метод Canvas.CopyRect

Form1.Canvas.CopyRect(RectForm,Picture.Canvas,RectPicture);
 // RectForm - прямоугольная область на форме, куда 
 // выводим часть рисунка
 //Picture -  TBitMap , куда предварительно загружен весь рисунок
 //RectPicture - прямоугольная часть рисунка, которую надо скопировать

[olchick]

Проблема даже нестолько в затирании куска изображения, а в следующем:
Это клиент-серверное приложение. На сервере, в самый первый раз, делается снимок всего экрана, затем он передается клиенту, клиент отрисовывает его на своей форме, затем на сервере копируется случайная часть экрана - прямоугольник с заданными шириной и высотой (300х300), на клиент передаются координаты этого прямоугольника и сам прямоугольник в виде потока. Клиент получает координаты прямоугольника и поток с прямоугольником и меняет первоначальное изображение, добавив до него в нужную позицию полученый кусок изображения.

Именно по этому выбрала подход для рисования через сообщения. Если бы это делать в image или чем-то подобном, получается постоянное мерцание.

Кроме всего, как и при рисовании на канве формы, так и при рисовании в графическом компоненте возникает главная проблема нашей дискусии - при перемещении формы, или при изменении ее размеров, или при помещении над канвой чужого окна, или даже при открытии меню ПУСК, часть предыдущего изображения стирается - что совсем не нужно. Вот и мучаюсь с этой проблемой...






А если вопрос звучит в первоначальной формулировке, то есть еще одно решение избавления от мерцания, но при этом не пропадает самая главная проблема.


unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, jpeg;
Const
WM_draw=WM_USER+1;
type
TForm1 = class(TForm)
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Button1Click(Sender: TObject);
private
procedure mydraw (var mes : TMessage); message WM_draw ;
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
MyRect: TRect;
MyBmp: TBitmap;
MyJpg: TJPEGImage;

implementation

{$R *.dfm}
procedure TForm1.MyDraw(var Mes: TMessage);
begin
Canvas.StretchDraw(MyRect, MyBmp);
//InvalidateRect(Handle, @MyRect, FALSE);
end;


procedure TForm1.FormCreate(Sender: TObject);
begin

MyBmp := TBitmap.Create;
MyJpg := TJPEGImage.Create;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
MyBmp.Free;
MyJpg.Free;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin

MyJpg.LoadFromFile('1.jpg');
MyBmp.Assign(MyJpg);
form1.Canvas.Draw(0,0,mybmp);
SetRect(MyRect, 100, 100, 400, 400);
end;

procedure TForm1.WMPaint(var Message: TWMPaint);
var
PS: TPaintStruct;
begin
BeginPaint(Handle, PS);

PostMessage(Handle, WM_draw, 0, 0);
EndPaint(Handle, PS);
end;

end.

[olchick]

Нашла ответ - всем спасибо за советы