Главная страница
    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.031 c
1-1082357260
samalex
2004-04-19 10:47
2004.05.09
Выделить необходимую ячейку в StringGrid


14-1082357056
Sectey
2004-04-19 10:44
2004.05.09
Помогите найти Банников Н.А.


1-1082495435
oleg_SYS
2004-04-21 01:10
2004.05.09
Кнопка на панеле задач


4-1079274429
Sergeika
2004-03-14 17:27
2004.05.09
Нужен низкоуровневый хук на клаву WH_KEYBOARD_LL


1-1082763405
/\_A_M_E_P
2004-04-24 03:36
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
Английский Французский Немецкий Итальянский Португальский Русский Испанский