Помогите с картинкой

← →
Андрей Валенинов (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"

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

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

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

//Создай новый проект, удали из него форму и 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 !!!

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