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

Вниз

Изменение размера формы мышкой   Найти похожие ветки 

← →
Дмитрий_05   (2005-06-29 17:40) [40]

У меня форма расстягивается, так вот чтобы она пропорционально расстягивалась, я вот как сделал: по углам прорисовываю изображения, которые не будут изменяться в размере с изменением размера окна, а между ними расстягивать изображения... Причем вот как: верхнее и нижнее по горизонтали, а левое и правое по вертикали... Переменные R, R_2, R_3, R_4: TRect; используются для подчета положения, где прорисовывать изображения в зависимости с размерами формы... И еще, я использую файлы bmp, имеет значение использовать jpg? Вот код - мелькающий...

type
 TForm1 = class(TForm)
 private
   procedure WMEraseBkGnd(var Msg: TMessage); message WM_ERASEBKGND;
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.WMEraseBkGnd(var Msg: TMessage);
var
 R, R_2, R_3, R_4: TRect;
 BMPMain, BMPTest: TBitmap;
begin
 BMPMain := TBitmap.Create;
 BMPTest := TBitmap.Create;
 try
   BMPMain.Width := Form1.Width;
   BMPMain.Height := Form1.Height;
   BMPMain.Canvas.Brush.Color := Form1.Color;
   BMPMain.Canvas.FillRect(ClientRect);
   BMPTest.LoadFromFile("LeftTop.bmp");
   R.Left:=BMPTest.Width;
   R.Top:=0;
   R_2.Left:=0;
   R_2.Top:=BMPTest.Height;
   BMPMain.Canvas.Draw(0, 0, BMPTest);
   BMPTest.LoadFromFile("RightTop.bmp");
   R.Right:=Form1.ClientWidth-BMPTest.Width;
   R_3.Top:=BMPTest.Height;
   BMPMain.Canvas.Draw(Form1.ClientWidth-BMPTest.Width, 0, BMPTest);
   BMPTest.LoadFromFile("Top.bmp");
   R.Bottom:=BMPTest.Height;
   BMPMain.Canvas.StretchDraw(R, BMPTest);
   BMPTest.LoadFromFile("LeftBottom.bmp");
   R_2.Bottom:=Form1.ClientHeight-BMPTest.Height;
   R_4.Left:=BMPTest.Width;
   BMPMain.Canvas.Draw(0, Form1.ClientHeight-BMPTest.Height, BMPTest);
   BMPTest.LoadFromFile("Left.bmp");
   R_2.Right:=BMPTest.Width;
   BMPMain.Canvas.StretchDraw(R_2, BMPTest);
   BMPTest.LoadFromFile("RightBottom.bmp");
   R_3.Bottom:=Form1.ClientHeight-BMPTest.Height;
   R_4.Right:=Form1.ClientWidth-BMPTest.Width;
   BMPMain.Canvas.Draw(Form1.ClientWidth-BMPTest.Width, Form1.ClientHeight-BMPTest.Height, BMPTest);
   BMPTest.LoadFromFile("Right.bmp");
   R_3.Left:=Form1.ClientWidth-BMPTest.Width;
   R_3.Right:=Form1.ClientWidth;
   BMPMain.Canvas.StretchDraw(R_3, BMPTest);
   BMPTest.LoadFromFile("Bottom.bmp");
   R_4.Top:=Form1.ClientHeight-BMPTest.Height;
   R_4.Bottom:=Form1.ClientHeight;
   BMPMain.Canvas.StretchDraw(R_4, BMPTest);

   Form1.Canvas.Draw(0, 0, BMPMain);
 finally
   FreeAndNil(BMPTest);
   FreeAndNil(BMPMain);
 end;
 Msg.Result := 1;
end;


---

← →
-=XP=- ©   (2005-06-29 17:48) [41]

BMPTest.LoadFromFile(); в WM_ERASEBKGND - это сильно.

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

---

← →
Дмитрий_05   (2005-06-29 18:16) [42]

Т.е. создать 8 переменных типа TBitmap, загрузить в них изображения из файлов, а в WM_ERASEBKGND перерисовывать из в замисимости от размера окна... Я так понял?

---

← →
Дмитрий_05   (2005-06-30 20:23) [43]

Вот переделанный код:

type
 TForm1 = class(TForm)
   procedure FormCreate(Sender: TObject);
   procedure FormDestroy(Sender: TObject);
 private
   BMPMain, BMPLeftTop, BMPRightTop, BMPTop, BMPLeftBottom, BMPLeft, BMPRightBottom, BMPRight, BMPBottom: TBitmap;
   procedure WMEraseBkGnd(var Msg: TMessage); message WM_ERASEBKGND;
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.WMEraseBkGnd(var Msg: TMessage);
var
 R_1, R_2, R_3, R_4: TRect;
begin
 BMPMain.Width := Form1.Width;
 BMPMain.Height := Form1.Height;

 BMPMain.Canvas.Brush.Color := Form1.Color;
 BMPMain.Canvas.FillRect(ClientRect);

 R_1.Left:=BMPLeftTop.Width;
 R_1.Top:=0;
 R_2.Left:=0;
 R_2.Top:=BMPLeftTop.Height;
 BMPMain.Canvas.Draw(0, 0, BMPLeftTop);
 R_1.Right:=Form1.ClientWidth-BMPRightTop.Width;
 R_3.Top:=BMPRightTop.Height;
 BMPMain.Canvas.Draw(Form1.ClientWidth-BMPRightTop.Width, 0, BMPRightTop);
 R_1.Bottom:=BMPTop.Height;
 BMPMain.Canvas.StretchDraw(R_1, BMPTop);
 R_2.Bottom:=Form1.ClientHeight-BMPLeftBottom.Height;
 R_4.Left:=BMPLeftBottom.Width;
 BMPMain.Canvas.Draw(0, Form1.ClientHeight-BMPLeftBottom.Height, BMPLeftBottom);
 R_2.Right:=BMPLeft.Width;
 BMPMain.Canvas.StretchDraw(R_2, BMPLeft);
 R_3.Bottom:=Form1.ClientHeight-BMPRightBottom.Height;
 R_4.Right:=Form1.ClientWidth-BMPRightBottom.Width;
 BMPMain.Canvas.Draw(Form1.ClientWidth-BMPRightBottom.Width, Form1.ClientHeight-BMPRightBottom.Height, BMPRightBottom);
 R_3.Left:=Form1.ClientWidth-BMPRight.Width;
 R_3.Right:=Form1.ClientWidth;
 BMPMain.Canvas.StretchDraw(R_3, BMPRight);
 R_4.Top:=Form1.ClientHeight-BMPBottom.Height;
 R_4.Bottom:=Form1.ClientHeight;
 BMPMain.Canvas.StretchDraw(R_4, BMPBottom);

 Form1.Canvas.Draw(0, 0, BMPMain);

 Msg.Result := 1;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 //Form1.DoubleBuffered:=true;

 BMPMain := TBitmap.Create;
 BMPLeftTop := TBitmap.Create;
 BMPRightTop := TBitmap.Create;
 BMPTop := TBitmap.Create;
 BMPLeftBottom := TBitmap.Create;
 BMPLeft := TBitmap.Create;
 BMPRightBottom := TBitmap.Create;
 BMPRight := TBitmap.Create;
 BMPBottom := TBitmap.Create;

 BMPLeftTop.LoadFromFile("LeftTop.bmp");
 BMPRightTop.LoadFromFile("RightTop.bmp");
 BMPTop.LoadFromFile("Top.bmp");
 BMPLeftBottom.LoadFromFile("LeftBottom.bmp");
 BMPLeft.LoadFromFile("Left.bmp");
 BMPRightBottom.LoadFromFile("RightBottom.bmp");
 BMPRight.LoadFromFile("Right.bmp");
 BMPBottom.LoadFromFile("Bottom.bmp");
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
 FreeAndNil(BMPLeftTop);
 FreeAndNil(BMPRightTop);
 FreeAndNil(BMPTop);
 FreeAndNil(BMPLeftBottom);
 FreeAndNil(BMPLeft);
 FreeAndNil(BMPRightBottom);
 FreeAndNil(BMPRight);
 FreeAndNil(BMPBottom);
 FreeAndNil(BMPMain);
end;

Прошу любить и жаловать... Может еще попроще как-то можно? А у самого у меня еще пара вопросов:
1). В коде мы создаем BMPMain переменную типа TBitmap, в которой все это прорисовываем, а потом ее прорисовываем в Form.Canvas-е, так вот может лучше будет сразу в Form.Canvas-е прорисовывать? Или тут есть какие-то минусы?
2). может всетаки действительно JPG-изображения использовать, или тут лучше всего BMP подходят?

---

← →
-=XP=- ©   (2005-06-30 21:04) [44]

Может еще попроще как-то можно?

Можно написать компонент, загружающий растры и прорисовывающий их на форме. Тогда у Вас получится нечто (хотя, и сейчас это так), именуемое "скины". Как упрощать - Ваше дело.

может лучше будет сразу в Form.Canvas-е прорисовывать? Или тут есть какие-то минусы?

Включите DoubleBuffered - можно и напрямую. Если выключить - будет мелькать при прорисовке.
Hint: DoubleBuffered использует промежуточный TBitmap, полный аналог Вашего BMPMain.

может всетаки действительно JPG-изображения использовать, или тут лучше всего BMP подходят?

Кто мешает? Качество только получше установите (соответственно, компрессию пониже).

---

← →
Дмитрий_05   (2005-07-01 17:45) [45]

Я хочу узнать зачем мы в WM_ERASEBKGND Msg.Result := 1;? А еще, у меня к тому же еще не стандартная форма(не прямоугольная). У меня на изображениях углы зарисованы серым цветом, чтобы потом программно их "обрезать", вот код:

procedure TForm1.CutSkinForm;                  
var
regn, tmpRegn, x, y: integer;
begin
 regn := CreateRectRgn(0, 0, Form1.ClientWidth, Form1.ClientHeight);

 for x := 1 to R_1.Left do
 for y := 1 to R_2.Top do
 if Form1.Canvas.Pixels[x - 1, y - 1] = clSilver then
   begin
   tmpRegn := CreateRectRgn(x - 1, y - 1, x, y);
   CombineRgn(regn, regn, tmpRegn, RGN_DIFF);
   DeleteObject(tmpRegn);
   end;

 for x := R_1.Left to R_1.Right do
 for y := 1 to R_1.Bottom do
 if Form1.Canvas.Pixels[x - 1, y - 1] = clSilver then
   begin
   tmpRegn := CreateRectRgn(x - 1, y - 1, x, y);
   CombineRgn(regn, regn, tmpRegn, RGN_DIFF);
   DeleteObject(tmpRegn);
   end;

 for x := R_1.Right to Form1.ClientWidth do
 for y := 1 to R_3.Top do
 if Form1.Canvas.Pixels[x - 1, y - 1] = clSilver then
   begin
   tmpRegn := CreateRectRgn(x - 1, y - 1, x, y);
   CombineRgn(regn, regn, tmpRegn, RGN_DIFF);
   DeleteObject(tmpRegn);
   end;

 for x := 1 to R_2.Right do
 for y := R_2.Top to R_2.Bottom do
 if Form1.Canvas.Pixels[x - 1, y - 1] = clSilver then
   begin
   tmpRegn := CreateRectRgn(x - 1, y - 1, x, y);
   CombineRgn(regn, regn, tmpRegn, RGN_DIFF);
   DeleteObject(tmpRegn);
   end;

 for x := R_3.Left to Form1.ClientWidth do
 for y := R_3.Top to R_3.Bottom do
 if Form1.Canvas.Pixels[x - 1, y - 1] = clSilver then
   begin
   tmpRegn := CreateRectRgn(x - 1, y - 1, x, y);
   CombineRgn(regn, regn, tmpRegn, RGN_DIFF);
   DeleteObject(tmpRegn);
   end;

 for x := 1 to R_4.Left do
 for y := R_2.Bottom to Form1.ClientHeight do
 if Form1.Canvas.Pixels[x - 1, y - 1] = clSilver then
   begin
   tmpRegn := CreateRectRgn(x - 1, y - 1, x, y);
   CombineRgn(regn, regn, tmpRegn, RGN_DIFF);
   DeleteObject(tmpRegn);
   end;

 for x := R_4.Left to R_4.Right do
 for y := R_4.Top to Form1.ClientHeight do
 if Form1.Canvas.Pixels[x - 1, y - 1] = clSilver then
   begin
   tmpRegn := CreateRectRgn(x - 1, y - 1, x, y);
   CombineRgn(regn, regn, tmpRegn, RGN_DIFF);
   DeleteObject(tmpRegn);
   end;

 for x := R_4.Right to Form1.ClientWidth do
 for y := R_3.Bottom to Form1.ClientHeight do
 if Form1.Canvas.Pixels[x - 1, y - 1] = clSilver then
   begin
   tmpRegn := CreateRectRgn(x - 1, y - 1, x, y);
   CombineRgn(regn, regn, tmpRegn, RGN_DIFF);
   DeleteObject(tmpRegn);
   end;

 SetWindowRgn(Form1.handle, regn, true);
end;

Как мне сделать растягивание такой формы, при изменении размеров окна без заголовка сначала отрисовывается рамка будущих размеров? Если делать через MouseDown, то надо будет каждый раз отслеживать MouseMove когда курсор подойдер к краю формы, чтобы поменять его на стрелочки, мне кажется это не очень хорошо... а еще и границу закругленного угла как-то определять надо, а это я не очень представляю как... Если делать через WM_NCHITEST, то у меня вокруг формы рисуется бордюр... Не красиво...

---

← →
-=XP=- ©   (2005-07-01 18:01) [46]

Я хочу узнать зачем мы в WM_ERASEBKGND Msg.Result := 1;?

WM_ERASEBKGND + F1 - там все написано

У меня на изображениях углы зарисованы серым цветом, чтобы потом программно их "обрезать"

Убрать приведенный код, и:
Form.TransparentColor := TRUE;
Form.TransparentColorValue := ColorToRGB(clGray); // Подставьте сюда Ваш "серый цвет"

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

Как Вы думаете, как это делается на самом деле?
Подсказка: Так же, как Вы сформулировали.

а еще и границу закругленного угла как-то определять надо, а это я не очень представляю как...

"Прозрачные" участки серые, говорите?
(Только не переспрашивайте, почему я это про это спрашиваю - думайте дальше сами).

---

← →
Дмитрий_05   (2005-07-01 18:21) [47]


Form.TransparentColor := TRUE;
Form.TransparentColorValue := ColorToRGB(clGray); // Подставьте сюда Ваш "серый цвет"

Я бы так с удовольствием сделал бы, только у меня в самом окне может быть любой цвет... И серый это не исключение... И получается так что он тоже становится прозрачным... Поэтому я и делаю это программное "обрезание" :)

---

← →
Дмитрий_05   (2005-07-03 00:35) [48]

Я когда изменяю размер окна

ReleaseCapture;
SendMessage(Form.Handle, WM_SYSCOMMAND, $f00e, 0);

таким способом, то бывает при уменьшении размера окна, форма "обрезается" почему-то... т.е. сама она становится такой как изменишь, но изображения на ней которые мы прорисовываем обрезаютя, как бы остаются за окном... Почему?

---

← →
Дмитрий_05   (2005-07-04 19:03) [49]

Может кто знает почему так происходит? Или в какой-то момент надо прорисовывать ее еще раз?

---

← →
Дмитрий_05   (2005-07-05 12:57) [50]

Может в MouseUp (после изменения размеров)перерисовывать форму или на какое-то еще сообщение??? Помогите плиз!!!

---

← →
Дмитрий_05   (2005-07-06 16:37) [51]

А почему у меня при такой прорисовки формы Label-ы исчезают?

---

← →
Дмитрий_05   (2005-07-06 21:17) [52]

Ну помогите плиз!!! Очень надо!

---

← →
Дмитрий_05   (2005-07-07 14:22) [53]

:-(((

---

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

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

Наверх

Память: 0.57 MB
Время: 0.018 c