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

Вниз

Окно по форме рисунка?   Найти похожие ветки 

← →
Vilko   (2006-09-22 18:18) [0]

Перерыв форум ответа так и не нашёл. Собственно вопрос таков . Возможно ли сделать окно по форме рисунка? Т.е не стандартный квадрат с кнопками свернуть закрыть . А допустим окно в виде звезды или вокруг моего рисунка в jpg..

---

← →
Vladimir Kladov   (2006-09-22 19:30) [1]

SetWindowRgn и KOL тут не при чем совершенно.

---

← →
ANTPro ©   (2006-09-22 22:37) [2]

Vilko   (22.09.06 18:18)
Не jpg а GIF
Этот вариант тормозный:
function BitmapToRgn(Image: PBitmap): HRGN;
var
 TmpRgn: HRGN;
 x, y: integer;
 ConsecutivePixels: integer;
 CurrentPixel: TColor;
 CreatedRgns: integer;
 CurrentColor: TColor;
 TransColor: TColor;
begin
 CreatedRgns := 0;
 Result := CreateRectRgn(0, 0, Image.Width, Image.Height);
 inc(CreatedRgns);
 TransColor:=Image.Canvas.Pixels[0,0];
 if (Image.Width = 0) or (Image.Height = 0) then
   exit;

 for y := 0 to Image.Height - 1 do
 begin
   CurrentColor := Image.Canvas.Pixels[0,y];
   ConsecutivePixels := 1;
   for x := 0 to Image.Width - 1 do
   begin
     CurrentPixel := Image.Canvas.Pixels[x, y];

     if CurrentColor = CurrentPixel then
       inc(ConsecutivePixels)
     else
     begin
       if CurrentColor = TransColor then
       begin
         TmpRgn := CreateRectRgn(x - ConsecutivePixels, y, x, y + 1);
         CombineRgn(Result, Result, TmpRgn, RGN_DIFF);
         inc(CreatedRgns);
         DeleteObject(TmpRgn);
       end;
       CurrentColor := CurrentPixel;
       ConsecutivePixels := 1;
     end;
   end;

   if (CurrentColor = clBlack) and (ConsecutivePixels > 0) then
   begin
     TmpRgn := CreateRectRgn(x-ConsecutivePixels, y, x, y+1);
     CombineRgn(Result, Result, TmpRgn, RGN_DIFF);
     inc(CreatedRgns);
     DeleteObject(TmpRgn);
   end;
 end;
end;  

procedure TForm1.KOLForm1FormCreate(Sender: PObj);
..........
begin

.......

 SetWindowRgn(Form.Handle,BitmapToRgn(Gif.Frames[0].Bitmap),False);
 
.......

end;


Пример 2:
Из VCL (Form.Transparent вроде) от Win2000 и выше но зато быстро (есть правда один глюк)

procedure TForm1.KOLForm1Paint(Sender: PControl; DC: HDC);
begin
 Form.Canvas.Rectangle(0,0,Form.ClientWidth,Form.ClientHeight);
 Form.Canvas.Brush.Color:=clRed;
 Form.Canvas.Rectangle(0,0,100,100);
end;

procedure TForm1.KOLForm1FormCreate(Sender: PObj);
begin
 SetWindowLong(Form.Handle, GWL_EXSTYLE, Form.ExStyle or WS_EX_LAYERED);
 SetLayeredWindowAttributes(Form.GetWindowHandle,clRed,255,LWA_COLORKEY or LWA_ALPHA);
end;


---

← →
Vladimir Kladov   (2006-09-23 08:09) [3]

Pixels - это медленно, используйте ScanLine. SetLayer... работает и в KOL, но это только от WinXP работает вроде бы. Еще не все перешли, всегда будут оставаться упорные пользователи, так и не слезшие с Win95.

---

← →
vilko   (2006-09-25 16:40) [4]

спасибо помогло

---

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

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

Наверх

Память: 0.47 MB
Время: 0.052 c