Главная страница
    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.036 c
14-1082230252
Черный прапорщик
2004-04-17 23:30
2004.05.09
Вот интересно мнение, программеров, разрабатывающих в одну «морду


1-1082357849
WondeRu
2004-04-19 10:57
2004.05.09
TCheckBox.State


14-1080221105
IronHawk
2004-03-25 16:25
2004.05.09
Киевская встреча Мастаков в реале №8


4-1079425476
bg8
2004-03-16 11:24
2004.05.09
Установка приоритета приложения


11-1051875935
MaximusXP
2003-05-02 15:45
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
Английский Французский Немецкий Итальянский Португальский Русский Испанский