Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2006.07.30;
Скачать: CL | DM;

Вниз

не стандартная форма   Найти похожие ветки 

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

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


 
PSPF2003 ©   (2006-07-06 15:20) [1]

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)


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

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


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

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

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


 
PSPF2003 ©   (2006-07-06 15:35) [4]

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


 
PSPF2003 ©   (2006-07-06 15:39) [5]

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


 
Footballer ©   (2006-07-06 15:39) [6]

Грузишь 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;


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

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


 
PSPF2003 ©   (2006-07-06 15:47) [8]

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


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

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


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

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


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

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


 
PSPF2003 ©   (2006-07-06 16:35) [12]

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


 
Quattro ©   (2006-07-06 16:41) [13]

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


 
antonn ©   (2006-07-06 17:13) [14]

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


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

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


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

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



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

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

Наверх




Память: 0.5 MB
Время: 0.029 c
15-1151599557
parovoZZ
2006-06-29 20:45
2006.07.30
Как бы поюзать png?


2-1152416078
elfen_kenny
2006-07-09 07:34
2006.07.30
TIBUpdateSQL блин


1-1150560642
Avgust
2006-06-17 20:10
2006.07.30
таймер в сервисе или как его включить-выключить???


2-1152527956
Postalll
2006-07-10 14:39
2006.07.30
Delphi &amp; ADO


15-1151568411
Джо
2006-06-29 12:06
2006.07.30
ROR на MIDletPascal или Java(J2ME)