Текущий архив: 2006.01.01;
Скачать: CL | DM;

Вниз

Скинообразная форма   Найти похожие ветки 

← →
Дмитрий_05   (2005-07-08 15:17) [0]

Хочу сделать непрямоугольную, скинообразную форму. Делаю я так:

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

var
Form1: TForm1;

implementation

{$R *.dfm}

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;

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
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");

CutSkinForm;
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;

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

---

← →
Kolan ©   (2005-07-08 23:03) [1]

Пройдись отладчиком. Если непоможет форматируй вопрос. Никому неохота разбирать то что ты написал...

---

← →
Kerk ©   (2005-07-08 23:31) [2]

function BitmapToRegion(oX, oY: Integer;
 TransColor: TColor): HRGN;
var
 TX,TY: Integer;
 XStart: Integer;
 Temp: HRGN;
begin
 Result := 0;
 for TY := 0 to FHeight - 1 do
 begin
   TX := 0;
   while TX < FWidth do
   begin
     while (TX < FWidth) and (FSprite.Canvas.Pixels[TX,TY] = TransColor) do
       Inc(TX);
     if TX >= FWidth then
       Break;
     XStart := TX;
     while (TX < FWidth) and (FSprite.Canvas.Pixels[TX,TY] <> TransColor) do
       Inc(TX);
     if Result = 0 then
       Result := CreateRectRgn(oX+XStart, oY+TY, oX+TX, oY+TY+1) else
     begin
       Temp := CreateRectRgn(oX+XStart, oY+TY, oX+TX, oY+TY+1);
       CombineRgn(Result,Result,Temp, RGN_OR);
       DeleteObject(Temp);
     end;
   end;
 end;
end;


---

← →
Дмитрий_05   (2005-07-12 18:46) [3]

А почему у меня в FormCreate не рисуется форма, чтобы потом "вырезать" серый цвет?

---

← →
Дмитрий_05   (2005-07-12 19:15) [4]

т.е. весь код WMEraseBkGnd я написал в FormCreate, но не рисуется почемуто...

---

← →
Керк   (2005-07-13 14:45) [5]

Дмитрий_05   (12.07.05 18:46) [3]
А почему у меня в FormCreate не рисуется форма, чтобы потом "вырезать" серый цвет?

FormCreate происходит до того, как форма показана. Соответствено не нарисована она еще в тот момент.

---

← →
Дмитрий_05   (2005-07-13 16:57) [6]

А когда тогда рисовать? В FormPaint, рисую Label-ы не исчезают, по сравнению с WMEraseBkGnd... Но и "вырезать" серый цвет в FormPaint каждый раз как-то накладно... Можно ввести булеву переменную, и она будет указывать "вырезать" серый цвет или нет... Т.е. один раз "вырежим", в FormPain, пока этого не понадобится еще раз. Может есть способ получше?

P.S. Когда форма изменит размеры, придется еще раз "вырезать" серый цвет, т.к. стороны и изображениями растянутся.

---

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

Помогите!!!

---

← →
Kerk ©   (2005-07-14 14:51) [8]

Ты расскажи что ты хочешь сделать. Тогда поможем.
Слушать про кривые методы решения непонятно чего не интересно.

---

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

А как тогда делать, скинообразную форму, только без компонентов?

---

← →
Antonn ©   (2005-07-14 15:56) [10]

> А как тогда делать, скинообразную форму, только без
> компонентов?

совсем без компанентов - думаю никак.
тебе нужно по маске(.bmp) вырезать форму, или как?

---

← →
Дмитрий_05   (2005-07-14 23:33) [11]

А если нужно просто форму с одним изображением сделать? Как хранить изображение? В отдельном файле вместе с exe-файлом или создать res-файл? Я хочу чтобы был просто exe-файл, может еще как можно хранить помимо res-файла?

---

← →
Kerk ©   (2005-07-15 00:29) [12]

Хранишь BMP-маску где угодно.
Потом создаешь регион с пом. [2]
Затем вызываешь SetWindowRgn с этим регионом.

---

← →
Дмитрий_05   (2005-07-15 01:32) [13]

Я имел ввиду как раз про то, что как хранить эту маску в exe-файле, есть ли способ еще какойнибудь кроме как res-файлы? А то я не совсем себе представляю как потом считывать это изображение...

---

← →
Kerk ©   (2005-07-15 08:59) [14]

Дмитрий_05   (15.07.05 1:32) [13]
Я имел ввиду как раз про то, что как хранить эту маску в exe-файле, есть ли способ еще какойнибудь кроме как res-файлы?

Ты явно чего-то недопонимаешь.. содержимое res-файла после компиляции проекта оказывается внутри exe.

---

← →
Дмитрий_05   (2005-07-15 12:55) [15]

Да, я знаю... Делал так небольшие инсталляторы...:-) Я хотел бы хотел узнать изображения так и сохраняют в exe-файлах, при помощи res-файлов или есть какойнибудь еще способ?

---

← →
Kerk ©   (2005-07-15 18:25) [16]

Ну а зачем тебе другой способ? :))

---

← →
Дмитрий_05   (2005-07-28 19:11) [17]

Что-то я опять пришел в тупик по созданию скинообразной формы.

type
 TCurPos = (L, R, T, B, LT, RT, LB, RB);

var
 Cr: TCurPos;
 isResizing, isCutForm: boolean;

procedure TForm1.FormPaint(Sender: TObject);
begin
... Прорисовка...

if not isCutForm then
 begin
 CutSkinForm;
 isCutForm:=true;
 end;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
 Y: Integer);
var
dx, dy: integer;
begin
if isResizing then
 begin
 DrawFocusRect(GetDC(0), WRect);
 if Cr=L then
   begin
   dx := oldPos.X - Mouse.CursorPos.X;
   Label15.Caption:=IntToStr(WRect.Left);
   if (WRect.Right - WRect.Left + dx > Form1.Constraints.MinWidth) and (WRect.Right + dx < Screen.Width) and (WRect.Right - WRect.Left + dx > Form1.Constraints.MinWidth) then WRect.Left := WRect.Left - dx;
   end;
 if Cr=R then
   begin
   dx := Mouse.CursorPos.X - oldPos.X;
   if (WRect.Right - WRect.Left + dx > Form1.Constraints.MinWidth) and (WRect.Right + dx < Screen.Width) then WRect.Right := WRect.Right + dx;
   end;
 if Cr=T then
   begin
   dy := oldPos.Y - Mouse.CursorPos.Y;
   if (WRect.Bottom - WRect.Top + dy > Form1.Constraints.MinHeight) and (WRect.Bottom + dy < Screen.Height) then WRect.Top := WRect.Top - dy;
   end;
 if Cr=B then
   begin
   dy := Mouse.CursorPos.Y - oldPos.Y;
   if (WRect.Bottom - WRect.Top + dy > Form1.Constraints.MinHeight) and (WRect.Bottom + dy < Screen.Height) then WRect.Bottom := WRect.Bottom + dy;
   end;
 if Cr=LT then
   begin
   dx := oldPos.X - Mouse.CursorPos.X;
   dy := oldPos.Y - Mouse.CursorPos.Y;
   if (WRect.Right - WRect.Left + dx > Form1.Constraints.MinWidth) and (WRect.Right + dx < Screen.Width) then WRect.Left := WRect.Left - dx;
   if (WRect.Bottom - WRect.Top + dy > Form1.Constraints.MinHeight) and (WRect.Bottom + dy < Screen.Height) then WRect.Top := WRect.Top - dy;
   end;
 if Cr=LB then
   begin
   dx := oldPos.X - Mouse.CursorPos.X;
   dy := Mouse.CursorPos.Y - oldPos.Y;
   if (WRect.Right - WRect.Left + dx > Form1.Constraints.MinWidth) and (WRect.Right + dx < Screen.Width) then WRect.Left := WRect.Left - dx;
   if (WRect.Bottom - WRect.Top + dy > Form1.Constraints.MinHeight) and (WRect.Bottom + dy < Screen.Height) then WRect.Bottom := WRect.Bottom + dy;
   end;
 if Cr=RT then
   begin
   dx := Mouse.CursorPos.X - oldPos.X;
   dy := oldPos.Y - Mouse.CursorPos.Y;
   if (WRect.Right - WRect.Left + dx > Form1.Constraints.MinWidth) and (WRect.Right + dx < Screen.Width) then WRect.Right := WRect.Right + dx;
   if (WRect.Bottom - WRect.Top + dy > Form1.Constraints.MinHeight) and (WRect.Bottom + dy < Screen.Height) then WRect.Top := WRect.Top - dy;
   end;
 if Cr=RB then
   begin
   dx := Mouse.CursorPos.X - oldPos.X;
   dy := Mouse.CursorPos.Y - oldPos.Y;
   if (WRect.Right - WRect.Left + dx > Form1.Constraints.MinWidth) and (WRect.Right + dx < Screen.Width) then WRect.Right := WRect.Right + dx;
   if (WRect.Bottom - WRect.Top + dy > Form1.Constraints.MinHeight) and (WRect.Bottom + dy < Screen.Height) then WRect.Bottom := WRect.Bottom + dy;
   end;

 oldPos := Mouse.CursorPos;
 DrawFocusRect(GetDC(0), WRect);
 end
else
 begin
 if (X <= 5) then
   begin
   if (Y <= 5) then Screen.Cursor:=crSizeNWSE
   else
     begin
     if (Y >= Form1.ClientHeight - 5) then Screen.Cursor:=crSizeNESW
     else
     Screen.Cursor:=crSizeWE;
     end;
   end
 else
   begin
   if (X >= Form1.ClientWidth - 5) then
     begin
     if (Y <= 5) then Screen.Cursor:=crSizeNESW
     else
       begin
       if (Y >= Form1.ClientHeight - 5) then Screen.Cursor:=crSizeNWSE
       else
       Screen.Cursor:=crSizeWE;
       end;
     end
   else
     if (Y <= 5) or (Y >= Form1.ClientHeight - 5) then Screen.Cursor:=crSizeNS
     else
     Screen.Cursor:=crDefault;
   end;
 end;
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
begin
if Button=mbLeft then
 begin
 if (X <= 5) then
   begin
   if (Y <= 5) then
     begin
     Cr:=LT;
     isResizing := true;
     oldPos := Mouse.CursorPos;
     GetWindowRect(Handle, WRect);
     DrawFocusRect(GetDC(0), WRect);
     end
   else
     begin
     if (Y >= Form1.ClientHeight - 5) then
       begin
       Cr:=LB;
       isResizing := true;
       oldPos := Mouse.CursorPos;
       GetWindowRect(Handle, WRect);
       DrawFocusRect(GetDC(0), WRect);
       end
     else
       begin
       Cr:=L;
       isResizing := true;
       oldPos := Mouse.CursorPos;
       Label13.Caption:=IntToStr(oldPos.X);
       GetWindowRect(Handle, WRect);
       DrawFocusRect(GetDC(0), WRect);
       end;
     end;
   end
 else
   begin
   if (X >= Form1.ClientWidth - 5) then
     begin
     if (Y <= 5) then
       begin
       Cr:=RT;
       isResizing := true;
       oldPos := Mouse.CursorPos;
       GetWindowRect(Handle, WRect);
       DrawFocusRect(GetDC(0), WRect);
       end
     else
       begin
       if (Y >= Form1.ClientHeight - 5) then
         begin
         Cr:=RB;
         isResizing := true;
         oldPos := Mouse.CursorPos;
         GetWindowRect(Handle, WRect);
         DrawFocusRect(GetDC(0), WRect);
         end
       else
         begin
         Cr:=R;
         isResizing := true;
         oldPos := Mouse.CursorPos;
         GetWindowRect(Handle, WRect);
         DrawFocusRect(GetDC(0), WRect);
         end;
       end;
     end
   else
   if (Y <= 5) then
     begin
     Cr:=T;
     isResizing := true;
     oldPos := Mouse.CursorPos;
     GetWindowRect(Handle, WRect);
     DrawFocusRect(GetDC(0), WRect);
     end;
   if (Y >= Form1.ClientHeight - 5) then
     begin
     Cr:=B;
     isResizing := true;
     oldPos := Mouse.CursorPos;
     GetWindowRect(Handle, WRect);
     DrawFocusRect(GetDC(0), WRect);
     end;
   end;
 end;
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
begin
if isResizing then
 begin
 DrawFocusRect(GetDC(0), WRect);
 Form1.Visible:=false;
 BoundsRect := WRect;
 isCutForm:=false;
 Form1.Invalidate;
 CutSkinForm;
 isResizing := false;
 Form1.Visible:=true;
 end;
end;


Т.е. в FormPain мы отрисовываем изображения на форме и проверяем вырезать нам серый цвет или нет, в зависимости от значения переменной isCutForm. Так вот проблема теперь вот какая, почему обычные кнопочки TButton непрорисовываются после изменения размера формы? Если убрать перерисовку формы Form1.Invalidate; в FormMouseUp то форма не перерисовывается после изменения размеров, т.е. остается такой-же или бывает вот как: Прорисовывается на как бы заднем плане, т.е. за формой новая... Всетаки почему кнопки исчезают?

---

← →
Масяня ©   (2005-07-30 11:40) [18]

Есть такая книга, называется "Delphi глазами ][акера". Там все описано (и кнопки будут)

---

← →
Дмитрий_05   (2005-07-30 23:12) [19]

Так там же все через компоненты а я хочу с помощью API

---

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

Текущий архив: 2006.01.01;
Скачать: CL | DM;

Наверх

Память: 0.54 MB
Время: 0.397 c