Недавно добавленные исходники

•  DeLiKaTeS Tetris (Тетрис)  3 927

•  TDictionary Custom Sort  6 031

•  Fast Watermark Sources  5 821

•  3D Designer  8 641

•  Sik Screen Capture  6 153

•  Patch Maker  6 594

•  Айболит (remote control)  6 583

•  ListBox Drag & Drop  5 442

•  Доска для игры Реверси  95 376

•  Графические эффекты  6 796

•  Рисование по маске  5 967

•  Перетаскивание изображений  4 970

•  Canvas Drawing  5 343

•  Рисование Луны  5 070

•  Поворот изображения  4 608

•  Рисование стержней  3 266

•  Paint on Shape  2 507

•  Генератор кроссвордов  3 398

•  Головоломка Paletto  2 699

•  Теорема Монжа об окружностях  3 494

•  Пазл Numbrix  2 295

•  Заборы и коммивояжеры  2 985

•  Игра HIP  1 945

•  Игра Go (Го)  1 858

•  Симулятор лифта  2 208

•  Программа укладки плитки  1 931

•  Генератор лабиринта  2 369

•  Проверка числового ввода  2 055

•  HEX View  2 376

•  Физический маятник  2 010

 
скрыть

  Форум  

Delphi FAQ - Часто задаваемые вопросы

| Базы данных | Графика и Игры | Интернет и Сети | Компоненты и Классы | Мультимедиа |
| ОС и Железо | Программа и Интерфейс | Рабочий стол | Синтаксис | Технологии | Файловая система |



Delphi Sources

Форма окна по Bitmap



Оформил: DeeCo

unit Unit1;

 interface

 uses
   Windows, Classes, SysUtils, Graphics, Forms;

 type
   TRGBArray = array[0..32767] of TRGBTriple;
   PRGBArray = ^TRGBArray;

 type
   TForm1 = class(TForm)
     procedure FormCreate(Sender: TObject);
     procedure FormDestroy(Sender: TObject);
   private
     { Private declarations }
     FRegion: THandle;
     function CreateRegion(Bmp: TBitmap): THandle;
   end;

 var
   Form1: TForm1;

 implementation

 {$R *.dfm}

 function TForm1.CreateRegion(Bmp: TBitmap): THandle;
 var
   X, Y, StartX: Integer;
   Excl: THandle;
   Row: PRGBArray;
   TransparentColor: TRGBTriple;
 begin
   Bmp.PixelFormat := pf24Bit;

   Result := CreateRectRGN(0, 0, Bmp.Width, Bmp.Height);

   for Y := 0 to Bmp.Height - 1 do
   begin
     Row := Bmp.Scanline[Y];

     StartX := -1;

     if Y = 0 then
       TransparentColor := Row[0];

     for X := 0 to Bmp.Width - 1 do
     begin
       if (Row[X].rgbtRed = TransparentColor.rgbtRed) and
         (Row[X].rgbtGreen = TransparentColor.rgbtGreen) and
         (Row[X].rgbtBlue = TransparentColor.rgbtBlue) then
       begin
         if StartX = -1 then StartX := X;
       end
       else
       begin
         if StartX > -1 then
         begin
           Excl := CreateRectRGN(StartX, Y, X + 1, Y + 1);
           try
             CombineRGN(Result, Result, Excl, RGN_DIFF);
             StartX := -1;
           finally
             DeleteObject(Excl);
           end;
         end;
       end;
     end;

     if StartX > -1 then
     begin
       Excl := CreateRectRGN(StartX, Y, Bmp.Width, Y + 1);
       try
         CombineRGN(Result, Result, Excl, RGN_DIFF);
       finally
         DeleteObject(Excl);
       end;
     end;
   end;
 end;

 procedure TForm1.FormCreate(Sender: TObject);
 var
   Bmp: TBitmap;
 begin
   Bmp := TBitmap.Create;
   try
     Bmp.LoadFromFile('C:\YourBitmap.bmp');
     FRegion := CreateRegion(Bmp);
     SetWindowRGN(Handle, FRegion, True);
   finally
     Bmp.Free;
   end;
 end;

 procedure TForm1.FormDestroy(Sender: TObject);
 begin
   DeleteObject(FRegion);
 end;

 end.




Похожие по теме исходники

Аудио Деформатор

Weather Info 2 (информация о погоде)

Оптимальное кодирование информации

Информация о процессах

 

Посторонние окна WinAPI

Bitmap Sharpen Filter

Simple Bitmap Rotation

Bitmap 32Bit Demo

 

Thread Bitmap (pencil drawings)




Copyright © 2004-2025 "Delphi Sources" by BrokenByte Software. Delphi World FAQ

Группа ВКонтакте