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

Вниз

Как создать панель (не форму) произвольной форми по маске из файл   Найти похожие ветки 

 
carmen   (2004-04-18 00:52) [0]

Как создать панель (не форму, а именно панель) произвольной форми по маске из файла.


 
carmen   (2004-04-18 00:52) [0]

Как создать панель (не форму, а именно панель) произвольной форми по маске из файла.


 
Pat ©   (2004-04-18 01:18) [1]

SetWindowRgn


 
Pat ©   (2004-04-18 01:18) [1]

SetWindowRgn


 
carmen   (2004-04-18 01:23) [2]

А пример можно?


 
carmen   (2004-04-18 01:23) [2]

А пример можно?


 
TUser ©   (2004-04-18 08:53) [3]

Да там ничего сложного. Скобку пишешь - делфи тебе сразу напишет, какие ему параметры нужны.


 
TUser ©   (2004-04-18 08:53) [3]

Да там ничего сложного. Скобку пишешь - делфи тебе сразу напишет, какие ему параметры нужны.


 
Mim1   (2004-04-18 10:59) [4]

--- программа 1 ----

Вот так сгенерить регион из картинки.


procedure TForm1.Button3Click(Sender: TObject);
var src1,src2:hrgn;
   x,y:integer;
   dc : hdc;
begin
 if rgn <> 0 then DeleteObject(RGN);

 with image1.Picture.Bitmap do
   begin
     src2:=createrectrgn(0,0,Width,Height);
     src1:=createrectrgn(0,0,1,1);
   end;  

 with image1.Picture.Bitmap do
   begin
     dc := Canvas.Handle;
     for y:=0 to Height do
     for x:=0 to Width do
       if Integer(GetPixel(dc,x,y))=clWhite then
         begin
           offsetrgn(src1,x,y);
           combinergn(src2,src2,src1,rgn_xor);
           offsetrgn(src1,-x,-y);
         end;
   end;
     
 rgn := src2;
 DeleteObject(src1);
end;

(белый цвет - прозрачный)

Вот так сохранить его в файл


procedure TForm1.Button1Click(Sender: TObject);
var p :  Pointer;
   DataSize : integer;
begin
 if rgn = 0 then exit;
 DataSize := GetRegionData(rgn,0,nil);

 GetMem(p,DataSize);
 prgnData(p)^.rdh.dwSize :=  sizeof(TRgnDataHeader);

 GetRegionData(rgn,DataSize,p);

 with TFileStream.Create("test",fmcreate) do
   begin
     WriteBuffer(datasize,sizeof(integer));
     WriteBuffer(p^,datasize);
     free;
   end;
 FreeMem(p,datasize);
end;


Вот так сделать из полученого файла ресурс

создать файл

region.rc
====cut====
main region loadoncall region
Splash region loadoncall SplashRgn
====cut====

откомпилять его brcc32 region.rc

---- программа 2 ----

Вот так загрузить его из ресурсов программы и применить его на форму.

procedure SetRegion(wnd:hwnd);
var ResHandle : DWORD;
   MemHandle : DWORD;
   ResPtr : pointer;
   Rgn : HRGN;
begin
 ResHandle := FindResource(hInstance, "MAIN", "REGION");
 if ResHandle = 0 then MessageBox (0,"z","x",mb_ok);
 MemHandle := LoadResource(hInstance, ResHandle);
 if MemHandle = 0 then MessageBox (0,"z","x",mb_ok);
 ResPtr    := LockResource(MemHandle);
 if ResPtr = nil then MessageBox (0,"z","x",mb_ok);

 rgn := ExtCreateRegion(nil,integer(resptr^),
   TRGNDATA(Pointer(Integer(resptr)+4)^));

 SetWindowRgn(Application.mainform.handle,rgn,true);

 UnlockResource(Cardinal(ResPtr));
 FreeResource(MemHandle);
end;

Procedure Button1Click(sender:tobject);
begin
 setregion(handle);
end;


 
Mim1   (2004-04-18 10:59) [4]

--- программа 1 ----

Вот так сгенерить регион из картинки.


procedure TForm1.Button3Click(Sender: TObject);
var src1,src2:hrgn;
   x,y:integer;
   dc : hdc;
begin
 if rgn <> 0 then DeleteObject(RGN);

 with image1.Picture.Bitmap do
   begin
     src2:=createrectrgn(0,0,Width,Height);
     src1:=createrectrgn(0,0,1,1);
   end;  

 with image1.Picture.Bitmap do
   begin
     dc := Canvas.Handle;
     for y:=0 to Height do
     for x:=0 to Width do
       if Integer(GetPixel(dc,x,y))=clWhite then
         begin
           offsetrgn(src1,x,y);
           combinergn(src2,src2,src1,rgn_xor);
           offsetrgn(src1,-x,-y);
         end;
   end;
     
 rgn := src2;
 DeleteObject(src1);
end;

(белый цвет - прозрачный)

Вот так сохранить его в файл


procedure TForm1.Button1Click(Sender: TObject);
var p :  Pointer;
   DataSize : integer;
begin
 if rgn = 0 then exit;
 DataSize := GetRegionData(rgn,0,nil);

 GetMem(p,DataSize);
 prgnData(p)^.rdh.dwSize :=  sizeof(TRgnDataHeader);

 GetRegionData(rgn,DataSize,p);

 with TFileStream.Create("test",fmcreate) do
   begin
     WriteBuffer(datasize,sizeof(integer));
     WriteBuffer(p^,datasize);
     free;
   end;
 FreeMem(p,datasize);
end;


Вот так сделать из полученого файла ресурс

создать файл

region.rc
====cut====
main region loadoncall region
Splash region loadoncall SplashRgn
====cut====

откомпилять его brcc32 region.rc

---- программа 2 ----

Вот так загрузить его из ресурсов программы и применить его на форму.

procedure SetRegion(wnd:hwnd);
var ResHandle : DWORD;
   MemHandle : DWORD;
   ResPtr : pointer;
   Rgn : HRGN;
begin
 ResHandle := FindResource(hInstance, "MAIN", "REGION");
 if ResHandle = 0 then MessageBox (0,"z","x",mb_ok);
 MemHandle := LoadResource(hInstance, ResHandle);
 if MemHandle = 0 then MessageBox (0,"z","x",mb_ok);
 ResPtr    := LockResource(MemHandle);
 if ResPtr = nil then MessageBox (0,"z","x",mb_ok);

 rgn := ExtCreateRegion(nil,integer(resptr^),
   TRGNDATA(Pointer(Integer(resptr)+4)^));

 SetWindowRgn(Application.mainform.handle,rgn,true);

 UnlockResource(Cardinal(ResPtr));
 FreeResource(MemHandle);
end;

Procedure Button1Click(sender:tobject);
begin
 setregion(handle);
end;


 
Mim1   (2004-04-18 11:01) [5]

ps на размер региона есть ограничения, подробности в справке.

В api есть родная функция создания региона из картинки, можно использовать ее (она должна быть на порядок быстрее).


 
Mim1   (2004-04-18 11:01) [5]

ps на размер региона есть ограничения, подробности в справке.

В api есть родная функция создания региона из картинки, можно использовать ее (она должна быть на порядок быстрее).


 
Mim1   (2004-04-18 11:10) [6]

Щас поискал в инете, нашел очень красявый способ с комментарими. (во всяком случае покрасивее моего)

http://fizmat.tspu.edu.ua/resources/info/mir/sources_ru/create_skin_window.shtml.htm


 
Mim1   (2004-04-18 11:10) [6]

Щас поискал в инете, нашел очень красявый способ с комментарими. (во всяком случае покрасивее моего)

http://fizmat.tspu.edu.ua/resources/info/mir/sources_ru/create_skin_window.shtml.htm


 
carmen   (2004-04-20 15:23) [7]

Вопрос стоит то в создании ПАНЕЛИ произвольной формы а не формы


 
carmen   (2004-04-20 15:23) [7]

Вопрос стоит то в создании ПАНЕЛИ произвольной формы а не формы


 
ASMiD   (2004-04-20 15:32) [8]

var
 pn:TPanel;
begin
 pn:=TPanel.Create(Self);
 pn.Left:=x;
 pn.Right:=y;
...

end;

x y  - значения из маски


 
ASMiD   (2004-04-20 15:32) [8]

var
 pn:TPanel;
begin
 pn:=TPanel.Create(Self);
 pn.Left:=x;
 pn.Right:=y;
...

end;

x y  - значения из маски


 
Mim1   (2004-04-23 19:31) [9]

carmen   (20.04.04 15:23) [7]

Панель, как и форма имеет является наследником twinobject и хендл . На панель так же как и на форму можно применить setwindowrgn.


 
Mim1   (2004-04-23 19:31) [9]

carmen   (20.04.04 15:23) [7]

Панель, как и форма имеет является наследником twinobject и хендл . На панель так же как и на форму можно применить setwindowrgn.



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

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

Наверх




Память: 0.5 MB
Время: 0.032 c
1-1082609206
Вова_
2004-04-22 08:46
2004.05.09
Как спрятать курсор?


1-1082388392
Тимохов
2004-04-19 19:26
2004.05.09
Thread.Terminated II.


1-1082386016
Koba
2004-04-19 18:46
2004.05.09
Zip


1-1082476423
ASvencim
2004-04-20 19:53
2004.05.09
Проблема с картинкой рабочего стола


3-1081435673
Wolferio
2004-04-08 18:47
2004.05.09
К предыдущему вопросу!!!





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
Английский Французский Немецкий Итальянский Португальский Русский Испанский