| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

не стандартная форма

Тимофей Юрьевич ©   (2006-07-06 15:11:00) 

доброго дня,у меня такой вопрос поднялся,нарисовал симпотичную форму в bmp,как сделать в дельфи форму по картинке?
Спасибо

---

Игорь Шевченко   (2006-07-06 17:38:00) [1]

http://www.delphikingdom.com/asp/viewitem.asp?catalogid=83

---

antonn   (2006-07-06 17:15:00) [2]

он альфаканал требует, у автора, видимо, pf24bit "и ниже", но с плавными переходами
http://kladovka.net.ru/index.cgi?pid=list&rid=318

---

antonn   (2006-07-06 17:13:00) [3]

интересно, где? :)

---

Quattro   (2006-07-06 16:41:00) [4]

у antonn'а где то лежал пример как это делать..не помню где, но мне его пример очень помог:)

---

PSPF2003   (2006-07-06 16:35:00) [5]

www.pspf2003.narod.ru\FormBitmap.rar
 443 703 бай

---

Тимофей Юрьевич   (2006-07-06 16:14:00) [6]

на закруглениях остается фиолетовый цвет,тот что прозрачный;)

---

PSPF2003   (2006-07-06 16:00:00) [7]

По краям белые линии. Хмм А другой рисунок не пробовал?
Вероятнее всего это из-за него. Чтобы так не “пролетать” для прозрачного цвета обычно используют $FE00FF

---

Тимофей Юрьевич   (2006-07-06 15:50:00) [8]

ага,все ничего,да по краям белые линии,правда не везде

---

PSPF2003   (2006-07-06 15:47:00) [9]

В Imade свойство Transparent включено(true)?

---

Тимофей Юрьевич   (2006-07-06 15:42:00) [10]

эт то получилось,но в тех местах которые должны быть пустыми(они другого цвета),как их убрать?

---

PSPF2003   (2006-07-06 15:39:00) [11]

Если не получается, напишу, где пример скачать

---

Footballer   (2006-07-06 15:39:00) [12]

Грузишь bmp в Image1 и в процедуре CreateBWindow обрезаешь...

type
...........................................
   procedure CreateBWindow(AHWND: HWND;bitmap:TBitmap);
   procedure FormCreate(Sender: TObject);
...........................................
implementation

{$R *.dfm}

procedure TForm1.CreateBWindow(AHWND: HWND;bitmap:TBitmap);
var
 back_color:COLORREF;
 wnd_dc,hdc_bmp,tmp_rgn,wnd_rgn:HDC;
 width,height,x,y,x0:integer;
begin
 width:=bitmap.width;
 height:=bitmap.height;
 wnd_dc:=GetDC(aHwnd);
 hdc_bmp:=CreateCompatibleDC(wnd_dc);
 SelectObject(hdc_bmp,bitmap.handle);
 back_color:=GetPixel(hdc_bmp,0,0);
 tmp_rgn:=CreateRectRgn(0,0,0,0);
 wnd_rgn:=CreateRectRgn(0,0,0,0);
   x:=0;
 for y:=0 to height-1 do begin
 while (x<width-1) do
 begin
   while((GetPixel(hdc_bmp,x,y)=back_color) and
   (x<width)) do inc(x);
     if(x<>width) then
     begin
     x0:=x;
     while((GetPixel(hdc_bmp,x,y)<>back_color) and
    (x<width)) do inc(x);
    tmp_rgn:=createrectrgn(x0,y,x,y+1);
    CombineRgn(wnd_rgn,wnd_rgn,tmp_rgn,RGN_XOR);
    end;
  end;
  x:=0;
  end;
  DeleteObject(tmp_rgn);
  DeleteDC(hdc_bmp);
  SetWindowRgn(aHwnd,wnd_rgn,True);
  DeleteObject(wnd_rgn);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 CreateBWindow(Form_help.Handle,Image1.Picture.Bitmap);
end;

---

PSPF2003   (2006-07-06 15:35:00) [13]

Надо так CreateBWindow(Handle, image1.Picture.Bitmap);

---

Тимофей Юрьевич   (2006-07-06 15:31:00) [14]

делаю так
var
gg:thandle;
begin
image1.Transparent:=true;
Form1.BorderStyle:= bsNone;
CreateBWindow(gg,image1.Picture.Bitmap);

но по картинке все равно форма не делается

---

PSPF2003   (2006-07-06 15:25:00) [15]

Нда забыл добавить
Image.Transparent = true;
Form.BorderStyle = bsNone;

---

PSPF2003   (2006-07-06 15:20:00) [16]

procedure CreateBWindow(AHWND: HWND; BITMAP: TBITMAP);
VAR
 Y : INTEGER;
 back_color: COLORREF;
 wnd_dc,hdc_bmp: HDC;
 tmp_rgn,wnd_rgn: HRGN;
 width,height,x,x0: Integer;
begin
width := bitmap.width;
height := bitmap.height;
wnd_dc := GetDC(aHwnd);
hdc_bmp := CreateCompatibleDC(wnd_dc);
SelectObject(hdc_bmp,bitmap.handle);
back_color := GetPixel(hdc_bmp,0,0);
tmp_rgn := CreateRectRgn(0,0,0,0);
wnd_rgn := CreateRectRgn(0,0,0,0);
x := 0;
for y := 0 to height-1 do
begin
while (x < width-1) do
begin
while ((GetPixel(hdc_bmp,x,y) = back_color) and
(x < width)) do inc(x);
if(x <> width) then
begin
x0 := x;
while ((GetPixel(hdc_bmp, x, y) <> back_color)and (x < width))
do inc(x); tmp_rgn := CreateRectRgn(x0,y,x,y+1);
CombineRgn(wnd_rgn,wnd_rgn,tmp_rgn,RGN_XOR);
end;
end;
x := 0;
end;
DeleteObject(tmp_rgn);
DeleteDC(hdc_bmp);
SetWindowRgn(aHwnd,wnd_rgn,True);
DeleteObject(wnd_rgn);
end;

При создании формы вызовешь процедуру, укажешь Handle формы и картинку (Image.Picture.Bitmap)

---

Наверх