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

Вниз

Помогите с картинкой   Найти похожие ветки 

← →
Андрей Валенинов   (2004-08-03 13:36) [0]

Уважаемые мастера, я хочу сделать программу на день рождения папе и в день рождения запустить у него на компьютере. Я хочу чтобы у него на рабочем столе появился букет цветов и надпись под ним.
Мне вот дали код который делает программу такой как исходная картинка, но он не работает, а я исправить его не могу так как для меня он очень сложен. Я только начал изучать язык.
Пожалуйста помогите исправить ошибки.

Я понимаю конечно что просьба немного глупая.

unit RgnUnit;
interface
uses
 Windows, SysUtils, Classes;
function CreateBitmapRgn(DC : hDC; Bitmap: hBitmap; TransClr: TColorRef): hRgn;

implementation
//создает регион из растра Bitmap для DC с удалением цвета TransClr
//внимание! TColorRef и TColor не одно и тоже.
//Для перевода используется функция ColorToRGB().
function CreateBitmapRgn(DC: hDC; Bitmap: hBitmap; TransClr: TColorRef): hRgn;
var
 bmInfo: TBitmap;               // структура BITMAP WinAPI
 W, H: Integer;                 // высота и ширина растра
 bmDIB: hBitmap;                // дискрептор независимого растра
 bmiInfo: BITMAPINFO;           // структура BITMAPINFO WinAPI
 lpBits, lpOldBits: PRGBTriple; // указатели на структуры RGBTRIPLE WinAPI
 lpData: PRgnData;              // указатель на структуру RGNDATA WinAPI
 X, Y, C, F, I: Integer;        // переменные циклов
 Buf: Pointer;                  // указатель
 BufSize: Integer;              // размер указателя
 rdhInfo: TRgnDataHeader;       // структура RGNDATAHEADER WinAPI
 lpRect: PRect;                 // указатель на TRect (RECT WinAPI)
begin
 Result:=0;
 //если растр не задан, выходим
 if Bitmap=0 then
   Exit;
 //узнаем размеры растра
 GetObject(Bitmap, SizeOf(bmInfo), @bmInfo);
 //используя структуру BITMAP
 W:=bmInfo.bmWidth;
 H:=bmInfo.bmHeight;
 //определяем смещение в байтах
 I:=(W*3)-((W*3) div 4)*4;
 if I<>0 then
   I:=4-I;
 //Пояснение: растр Windows Bitmap читается снизу вверх, причем каждая строка
 //дополняется нулевыми байтами до ее кратности 4.
 //для 32-х битный растров такой сдвиг делать не надо.
 //заполняем BITMAPINFO для передачи в CreateDIBSection
 bmiInfo.bmiHeader.biWidth:=W;            // ширина
 bmiInfo.bmiHeader.biHeight:=H;           // высота
 bmiInfo.bmiHeader.biPlanes:=1;           // всегда 1
 bmiInfo.bmiHeader.biBitCount:=24;        // три байта на пиксель
 bmiInfo.bmiHeader.biCompression:=BI_RGB; // без компрессии
 bmiInfo.bmiHeader.biSizeImage:=0;        // размер не знаем, ставим в ноль
 bmiInfo.bmiHeader.biXPelsPerMeter:=2834; // пикселей на метр, гор.
 bmiInfo.bmiHeader.biYPelsPerMeter:=2834; // пикселей на метр, верт.
 bmiInfo.bmiHeader.biClrUsed:=0;          // палитры нет, все в ноль
 bmiInfo.bmiHeader.biClrImportant:=0;     // то же
 bmiInfo.bmiHeader.biSize:=SizeOf(bmiInfo.bmiHeader); // размер структруы
 bmDIB:=CreateDIBSection(DC, bmiInfo, DIB_RGB_COLORS,
 Pointer(lpBits), 0, 0);
 //создаем независимый растр WxHx24, без палитры, в указателе lpBits получаем
 //адрес первого байта этого растра. bmDIB - дискрептор растра
 //заполняем первые шесть членов BITMAPINFO для передачи в GetDIBits
 bmiInfo.bmiHeader.biWidth:=W;            // ширина
 bmiInfo.bmiHeader.biHeight:=H;           // высота
 bmiInfo.bmiHeader.biPlanes:=1;           // всегда 1
 bmiInfo.bmiHeader.biBitCount:=24;        // три байта на пиксель
 bmiInfo.bmiHeader.biCompression:=BI_RGB; // без компресси
 bmiInfo.bmiHeader.biSize:=SizeOf(bmiInfo.bmiHeader); // размер структуры
 GetDIBits(DC, Bitmap, 0, H-1, lpBits, bmiInfo, DIB_RGB_COLORS);
 //конвертируем исходный растр в наш с его копированием по адресу lpBits
 lpOldBits:=lpBits; //запоминаем адрес lpBits
 //первый проход - подсчитываем число прямоугольников, необходимых для
 //создания региона
 C:=0; //сначала ноль
 //проход снизу вверх
 for Y:=H-1 downto 0 do
 begin
   X:=0;
   //от 0 до ширины-1
   while Xdo
   begin
     //пропускаем прзрачный цвет, увеличивая координату и указатель
     while (RGB(lpBits.rgbtRed, lpBits.rgbtGreen,
     lpBits.rgbtBlue)=TransClr) and (Xdo
     begin
       Inc(lpBits);
       X:=X+1;
     end;
     //если нашли не прозрачный цвет, то считаем, сколько точек в ряду он идет
     if RGB(lpBits.rgbtRed, lpBits.rgbtGreen,
     lpBits.rgbtBlue)<>TransClr then
     begin
       while (RGB(lpBits.rgbtRed, lpBits.rgbtGreen,
       lpBits.rgbtBlue)<>TransClr) and (Xdo
       begin
         Inc(lpBits);
         X:=X+1;
       end;
       //увиличиваем счетчик прямоугольников
       C:=C+1;
     end;
   end;
   //ряд закончился, необходимо увеличить указатель до кратности 4
   PChar(lpBits):=PChar(lpBits)+I;
 end;
 lpBits:=lpOldBits; //восстанавливаем значение lpBits
 //Заполняем структуру RGNDATAHEADER
 rdhInfo.iType:=RDH_RECTANGLES;     // будем использовать прямоугольники
 rdhInfo.nCount:=C;                 // их количество
 rdhInfo.nRgnSize:=0;               // размер выделяем памяти не знаем
 rdhInfo.rcBound:=Rect(0, 0, W, H); // размер региона
 rdhInfo.dwSize:=SizeOf(rdhInfo);   // размер структуры
 //выделяем память для струтуры RGNDATA:
 //сумма RGNDATAHEADER и необходимых на прямоугольников
 BufSize:=SizeOf(rdhInfo)+SizeOf(TRect)*C;
 GetMem(Buf, BufSize);
 //ставим указатель на выделенную память
 lpData:=Buf;
 //заносим в память RGNDATAHEADER
 lpData.rdh:=rdhInfo;
 //Заполдяенм память прямоугольниками
 lpRect:=@lpData.Buffer; //первый прямоугольник
 for Y:=H-1 downto 0 do
 begin
   X:=0;
   while Xdo
   begin
     while (RGB(lpBits.rgbtRed, lpBits.rgbtGreen,
     lpBits.rgbtBlue)=TransClr) and (Xdo
     begin
       Inc(lpBits);
       X:=X+1;
     end;
     if RGB(lpBits.rgbtRed, lpBits.rgbtGreen,
     lpBits.rgbtBlue)<>TransClr then
     begin
       F:=X;
       while (RGB(lpBits.rgbtRed, lpBits.rgbtGreen,
       lpBits.rgbtBlue)<>TransClr) and (Xdo
       begin
         Inc(lpBits);
         X:=X+1;
       end;
       lpRect^:=Rect(F, Y, X, Y+1); //заносим координаты
       Inc(lpRect); //переходим к следующему
     end;
   end;
   PChar(lpBits):=PChar(lpBits)+I;
 end;
 //после окночания заполнения структуры RGNDATA можно создавать регион.
 //трансформации нам не нужны, ставим в nil, указываем размер
 //созданной структуры и ее саму.
 //создаем регион
 Result:=ExtCreateRegion(nil, BufSize, lpData^);
 //теперь структура RGNDATA больше не нужна, удаляем
 FreeMem(Buf, BufSize);
 //созданный растр тоже удаляем
 DeleteObject(bmDIB);
end;
end.

---

← →
Profi ©   (2004-08-03 14:58) [1]

Не парься! Нарисуй bmp"шку и натени на рабочий стол функцией systemparametersinfo.

---

← →
Андрей Валенинов   (2004-08-03 15:21) [2]

для Profi

Да в том то и дело что мне не на рабочий стол надо - а мне надо именно форму такую с надписью под букетом. На рабочий стол он мне запретил картинки ставить - говорит систему это перегружает.

---

← →
parovoZZ ©   (2004-08-03 16:09) [3]

Не думаю, что смена картинки на столе перегрузит систему больше, чем выше приведённый код. Скорее даже наоборот.
По сабжу: что именно и где не работает? Как пользуешься вышеприведённой функцией? Я делал тоже самое, но тело функции проще, потому как параметры картинки известны.

---

← →
parovoZZ ©   (2004-08-03 16:09) [4]

Не думаю, что смена картинки на столе перегрузит систему больше, чем выше приведённый код. Скорее даже наоборот.
По сабжу: что именно и где не работает? Как пользуешься вышеприведённой функцией? Я делал тоже самое, но тело функции проще, потому как параметры картинки известны.

---

← →
Андрей Валенинов   (2004-08-03 16:41) [5]

для parovoZZ ©

У меня папа говорит что на рабочем столе не должно быть никогда никаких картинок, потому что картинки на рабочий стол придумали ставить уроды и изза картинок компьютер повиснит, точнее будет перегружаться. А мои программы которые я делаю по учебнику папа разрешает запускать и говорит что гипертреидинг делает так что сколькобы программ не работало одновременно он не повиснит.
У меня нету функции простее чем эта. Я изучаю книжку "Delphi для чайников". А там не учат делать то что мне нужно. (мне 13 лет и я занимаюсь делфи только два месяца и поэтому еще не умею ничего крутова).
Если вы не можите помочь исправить ошибки, немогли бы вы
написать вашу простую функию и расказать как ей пользоваться.

---

← →
Кириешки ©   (2004-08-03 16:46) [6]

"картинки на рабочий стол придумали ставить уроды и изза картинок компьютер повиснит"

Хотел бы я пообщаться с твоим папой }:-#

---

← →
parovoZZ ©   (2004-08-03 16:46) [7]

По поводу картинок я промолчу.

---

← →
Кириешки ©   (2004-08-03 16:57) [8]

Я твоему папе не букет цветов бы нарисовал с надписью внизу, а просто одну надпись - "Good Lamed - Dead Lamer"

---

← →
Mihey_temporary ©   (2004-08-03 18:26) [9]

Похоже на развод. Если процессор с Hyperthreading"ом, то наверное и Doom 3 пойдёт.

А по делу. http://www.torry.net/pages.php?id=94

---

← →
parovoZZ ©   (2004-08-03 20:18) [10]

Держи то, что обещал:


//Создай новый проект, удали из него форму и Unit1. Нижеследующий код вставь в проект (предварительно удали всё из проекта).

program Region;

uses
 windows,
 messages;

const
Picture = "Ball_orig.bmp";//Файл с картинокй, обязательно должен быть с расширением *.BMP (без компрессии), должен лежать в той же папке, где эта прога. В противном случае здесь должен быть прописан полный путь к файлу.

var
WClass        : TWndClassEx;
Handle        : HWND;         //
Msg           : TMsg;
Image         : HBitmap;
PictureDC     : HDC;
Height, Width : Byte;

//Почти тоже самое, только намного короче
function CreateRgn (DC : HDC) : HRGN;
var
Rgn                        : HRGN;
x, y                       : integer;
ConsecutivePixels          : integer;
CurrentPixel, CurrentColor : Cardinal;
Transparent                : Cardinal;
begin

Result := CreateRectRgn (0, 0, Width, Height);
Transparent := GetPixel (DC, 0, 0);//Цвет отрезаемых пикселей устанавливается по крайнему верхнему левому пикселю (можно изменить на любой другой). Регион не может поделить вырезаемую картинку на части, поэтому она должна быть цельной!!!
for y := 0 to Height - 1 do
 begin
  CurrentColor := GetPixel (DC, 0, y);
  ConsecutivePixels := 1;
  for x := 0 to Width - 1 do
   begin
    CurrentPixel := GetPixel (DC, x, y);
    if CurrentColor = CurrentPixel then inc (ConsecutivePixels)
     else
      begin
       if CurrentColor = Transparent then
        begin
         Rgn := CreateRectRgn (x - ConsecutivePixels, y, x, y + 1);
         CombineRgn (Result, Result, Rgn, RGN_DIFF);
         DeleteObject (Rgn);
        end;
      CurrentColor := CurrentPixel;
      ConsecutivePixels := 1;
     end;
    end;

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

procedure LoadPicture;
var
DC : HDC;
BM : BitMap;

begin
Image := LoadImage (0, picture, Image_Bitmap, 0, 0, LR_LOADFROMFILE or LR_CREATEDIBSECTION);
DC := GetDC (Handle);
PictureDC := CreateCompatibleDC (DC);
SelectObject (PictureDC, Image);
GetObject (Image, SizeOf (BitMap), @BM);
Height := BM.bmHeight;//Иногда возникают ошибки с определением размера картинки, если такое случится, придётся прописывать вручную
Width := BM.bmWidth;
ReleaseDC (Handle, DC);
end;

function WindowProc (Handle : THandle; Msg : Integer; Wparam : Wparam; Lparam : Lparam) : LResult; stdcall;
var
 DC        : HDC;
 Rgn       : HRGN;
 Rect      : TRect;

begin

Result := 0;

case Msg of
                WM_Create   : begin//Вырезаем регион при создании формы
                               if GetTopWindow(0) <> Handle then
                                  SetWindowPos(handle, HWND_TOPMOST, 100, 100, Width, Height,
                                                    swp_nomove Or swp_nosize Or swp_showwindow);
                                  DC := GetDC (Handle);
                                  Rgn := CreateRgn (PictureDC);
                                  SetWindowRgn (Handle, Rgn, true);
                                  BitBlt (DC, 0, 0, Width, Height, PictureDC, 0, 0, SrcCopy);
                                  DeleteObject (Rgn);
                                  ReleaseDC (Handle, DC);
                             end;

            WM_LButtonDown : SendMessage(Handle, WM_NCLBUTTONDOWN, HTCAPTION, 0);//Перемещаем окно за любое место))

    WM_WINDOWPOSCHANGING
    or WM_WINDOWPOSCHANGED : begin//При перемещениях формы перерисовываемся
                               DC := GetDC (Handle);
                               BitBlt (DC, 0, 0, Width, Height, PictureDC, 0, 0, SrcCopy);
                               ReleaseDC (Handle, DC);
                             end;
                               
            WM_RButtonDown : SendMessage (Handle, WM_Destroy, 0, 0);//Клик правой кнопкой мышки приводит к уничтожению окна

                WM_Destroy : begin//Уничтожаем окно
                               PostQuitMessage (0);
                               Exit;
                             end;

     else Result := DefWindowProc (Handle, Msg, Wparam, Lparam);
end;

end;

begin

FillChar (WClass, SizeOf (WClass), 0);
WClass.cbSize := SizeOf (WClass);
WClass.hCursor := LoadCursor (0, IDC_HAND);
WClass.hInstance := hInstance;
WClass.lpszClassName := "Region";
WClass.lpfnWndProc := @WindowProc;
RegisterClassEx (WClass);
LoadPicture;

Handle := CreateWindowEx (WS_EX_ToolWindow, "Region", "", WS_Popup,
                           0, 0, Width, Height, 0, 0, hInstance, nil);


ShowWindow (Handle, SW_SHOW);

While GetMessage (Msg, 0, 0, 0) do
   begin
     DispatchMessage (Msg);
   end;

if Image > 0 then DeleteObject (Image);
if PictureDC > 0 then DeleteDC (PictureDC);
end.



PS: © За последствия работы этого кода я никакой ответственности не несу. Используй на свой страх и риск. На пне 4 и ХР это всё работает на ура.

//Редкий русский программист знает ещё и родной язык. Почему так?

---

← →
Андрей Валенинов   (2004-08-03 21:38) [11]

Спасибо вам большое Мастер parovoZZ !!!

---

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

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

Наверх

Память: 0.53 MB
Время: 0.034 c