Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Начинающим";
Текущий архив: 2006.07.30;
Скачать: [xml.tar.bz2];

Вниз

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

 
Тимофей Юрьевич ©   (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;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.48 MB
Время: 0.012 c
2-1151914701
D@Nger
2006-07-03 12:18
2006.07.30
Координаты ячейки DBGrida a


15-1151522536
Avgust
2006-06-28 23:22
2006.07.30
лицензия...


2-1152392627
privet
2006-07-09 01:03
2006.07.30
кнопошки


15-1151481375
IMHO
2006-06-28 11:56
2006.07.30
Слово об OpenOffice


15-1151652157
Артем22
2006-06-30 11:22
2006.07.30
"Компиляторы" e-books





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский