Модераторы: Snowy, Alexeis, MetalFan
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Нарисовать на рабочем столе свой битмап 
V
    Опции темы
Zlo
Дата 15.9.2006, 19:53 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


Профиль
Группа: Участник
Сообщений: 235
Регистрация: 18.9.2004

Репутация: нет
Всего: 1
Нашел вот такой код
Код

procedure PaintDesk;
var
  c: TCanvas;
begin
  c := TCanvas.Create;
       
  c.Handle := GetDC(GetWindow(GetDesktopWindow, GW_OWNER));

       //теперь на рабочем столе можно рисовать как на форме
  c.FillRect(rect(10,10,300,450));


  c.free;
end;

как бы сделать так чтобы он нарисовал мой бмп?
PM MAIL   Вверх
Alexeis
Дата 15.9.2006, 21:19 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Амеба
Group Icon


Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 55
Всего: 459
Код

procedure TForm1.Button1Click(Sender: TObject);
var
  b : TBitmap;
  c: TCanvas;

begin
  c := TCanvas.Create;
  c.Handle := GetDC(GetWindow(GetDesktopWindow, GW_OWNER));
  b := TBitmap.Create;
  b.Height := 200;
  b.Width := 200;
  b.Canvas.Ellipse(10, 10, 200, 200);
  c.Draw(10, 10, b);
  c.free;
  b.Free;
end;



--------------------
Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать
PM ICQ Skype   Вверх
Zlo
Дата 15.9.2006, 23:07 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


Профиль
Группа: Участник
Сообщений: 235
Регистрация: 18.9.2004

Репутация: нет
Всего: 1
Спасибо большое, сделал вот так:
Код

procedure PaintDesk;
var
  b : TBitmap;
  c: TCanvas;

begin
  c := TCanvas.Create;
  c.Handle := GetDC(GetWindow(GetDesktopWindow, GW_OWNER));
  b := TBitmap.Create;
  b.Height := 50;
  b.Width := 50;
  b.Canvas.Ellipse(10, 10, 200, 200);
  b.LoadFromFile('G:\Program Files\Borland\Delphi7\Projects\picture7196683884486.bmp');
  c.Draw(10, 10, b);
  c.free;
  b.Free;
end;
{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
   PaintDesk;
end;


А как можно сделать что бы фон под рисунким был цвета фона рабочего стола?
PM MAIL   Вверх
Alexeis
Дата 15.9.2006, 23:14 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Амеба
Group Icon


Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 55
Всего: 459
Цитата(Zlo @  15.9.2006,  23:07 Найти цитируемый пост)

А как можно сделать что бы фон под рисунким был цвета фона рабочего стола?

Скопировать фрагмент канваса рабочего стола на битмап перед рисованием при помощи функции copyRect


--------------------
Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать
PM ICQ Skype   Вверх
Zlo
Дата 15.9.2006, 23:16 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


Профиль
Группа: Участник
Сообщений: 235
Регистрация: 18.9.2004

Репутация: нет
Всего: 1
попробовал млодифицировать пример из DRKB вывод текста на битмапе с фоном битмапа но не получилось вот код:

Код примера из DRKB
Код

{Как разместить прозрачную надпись на TBitmap? }

procedure TForm1.Button1Click(Sender: TObject); 
var 
   OldBkMode : integer; 
begin 
   Image1.Picture.Bitmap.Canvas.Font.Color := clBlue; 
   OldBkMode := SetBkMode(Image1.Picture.Bitmap.Canvas.Handle,TRANSPARENT); 
   Image1.Picture.Bitmap.Canvas.TextOut(10, 10, 'Hello'); 
   SetBkMode(Image1.Picture.Bitmap.Canvas.Handle,OldBkMode); 
end; 


Вот то что сделал я (может что-то не так сделал?)
Код

procedure PaintDesk;
var
  b : TBitmap;
  c: TCanvas;
  OldBkMode : integer;

begin
  c := TCanvas.Create;
  c.Handle := GetDC(GetWindow(GetDesktopWindow, GW_OWNER));
  b := TBitmap.Create;
  b.Height := 50;
  b.Width := 50;
  //b.Canvas.Ellipse(10, 10, 200, 200);

  b.LoadFromFile('G:\Program Files\Borland\Delphi7\Projects\picture7196683884486.bmp');
  OldBkMode := SetBkMode(b.Canvas.Handle,TRANSPARENT);
  c.Draw(10, 10, b);
  SetBkMode(b.Canvas.Handle,OldBkMode);
  c.free;
  b.Free;
end;


Добавлено @ 23:17 

Цитата(alexeis1 @  15.9.2006,  23:14 Найти цитируемый пост)
Скопировать фрагмент канваса рабочего стола на битмап перед рисованием при помощи функции copyRect

а можно пример?
PM MAIL   Вверх
Alexeis
Дата 15.9.2006, 23:34 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Амеба
Group Icon


Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 55
Всего: 459
Цитата(Zlo @  15.9.2006,  23:16 Найти цитируемый пост)
а можно пример?

Код

procedure TForm1.Button1Click(Sender: TObject);
var
  b : TBitmap;
  c : TCanvas;
begin
  c := TCanvas.Create;
  c.Handle := GetDC(GetWindow(GetDesktopWindow, GW_OWNER));
  b := TBitmap.Create;
  b.Height := 200;
  b.Width := 200;
  b.Canvas.CopyRect(rect(-10, -10, 200, 200), c, rect(0, 0, 210, 210));
  b.Canvas.Ellipse(10, 10, 200, 200);
  c.Draw(10, 10, b);
  c.free;
  b.Free;
end;





--------------------
Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать
PM ICQ Skype   Вверх
Zlo
Дата 15.9.2006, 23:41 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


Профиль
Группа: Участник
Сообщений: 235
Регистрация: 18.9.2004

Репутация: нет
Всего: 1
Код

var
  b : TBitmap;
  c : TCanvas;
begin
  c := TCanvas.Create;
  c.Handle := GetDC(GetWindow(GetDesktopWindow, GW_OWNER));
  b := TBitmap.Create;
  b.Height := 50;
  b.Width := 50;
  //b.LoadFromFile('G:\Program Files\Borland\Delphi7\Projects\picture7196683884486.bmp');

  b.Canvas.CopyRect(rect(-10, -10, 200, 200), c, rect(0, 0, 210, 210));
  //b.Canvas.Ellipse(10, 10, 200, 200);
  b.LoadFromFile('G:\Program Files\Borland\Delphi7\Projects\picture7196683884486.bmp');
  c.Draw(10, 10, b);
  c.free;
  b.Free;
end;

вот так всеравно черный фон остается

Добавлено @ 23:45 
а картинка вот эта
user posted image
PM MAIL   Вверх
Alexeis
Дата 15.9.2006, 23:48 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Амеба
Group Icon


Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 55
Всего: 459
Zlo, конечно остается, ведь исходная картинка с фоном рабочего стола заменяется новой smile 
Нужно новую накладывать на старую с прозрачностью, причем эта картинка должна быть 32 бита на пиксель с установленым альфа каналом. Как накладывать картинку с прозрачностью как то уже показывал Snowy.

Добавлено @ 23:50 
Код

procedure TForm1.Button1Click(Sender: TObject);    
var    
  bmp1, bmp2: TBitMap;    
  Blend: TBlendFunction;    
begin    
  bmp1 := TBitMap.Create;    
  bmp2 := TBitMap.Create;    
  bmp1.LoadFromFile('C:\1.bmp'); // загружаем 1 битмап    
  bmp2.LoadFromFile('C:\2.bmp'); // и второй битмап    
  bmp1.PixelFormat := pf32bit; // переводим оба в 32 бит    
  bmp2.PixelFormat := pf32bit;    
  Blend.BlendOp := AC_SRC_OVER;    
  Blend.BlendFlags := 0;    
  Blend.SourceConstantAlpha := 128; // прозрачность 50% (0 - 255)    
  Blend.AlphaFormat := AC_SRC_ALPHA;    
  // накладываем битмап 2 на битмап 1    
  if Windows.AlphaBlend(bmp1.Canvas.Handle, 0, 0, bmp1.Width, bmp1.Height,    
                        bmp2.Canvas.Handle, 0, 0, bmp2.Width, bmp2.Height, Blend) then    
    Canvas.Draw(0, 0, bmp1) // рисуем результат на форме    
  else ShowMessage(IntToStr(GetLastError)); // или код ошибки, если наложить не удалось    
  bmp1.Free; bmp2.Free; // уничтожаем битмапы    
end;



--------------------
Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать
PM ICQ Skype   Вверх
Zlo
Дата 15.9.2006, 23:51 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


Профиль
Группа: Участник
Сообщений: 235
Регистрация: 18.9.2004

Репутация: нет
Всего: 1
Странно а если сделать рисунок 16 бит (до этого был 24) то выводится полупрозрачный прямоугольник
PM MAIL   Вверх
Alexeis
Дата 15.9.2006, 23:55 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Амеба
Group Icon


Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 55
Всего: 459
Вообще тут придется поиграться с параметром 
Blend.AlphaFormat 
и установить 
Blend.SourceConstantAlpha := 255;  или 0; в зависимости от типа операции.


--------------------
Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать
PM ICQ Skype   Вверх
Zlo
Дата 15.9.2006, 23:59 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


Профиль
Группа: Участник
Сообщений: 235
Регистрация: 18.9.2004

Репутация: нет
Всего: 1
Все равно не получилось smile
Но спасибо большое что возишся со мной!
Если не Влом то помоги плиз

Добавлено @ 00:01 
а какие параметры могут принимать Blend.AlphaFormat  ?
PM MAIL   Вверх
Alexeis
Дата 16.9.2006, 01:17 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Амеба
Group Icon


Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 55
Всего: 459
Вот сюда я закачал весь проект целиком (с рисунками) для наложения дельфина, на облака
http://alexei-s1.narod.ru/Samples/trans.rar
Код

type
  TRGBA = packed record
           case Byte of
           0: (B, G, R, A : Byte);
           1: (Acolor : Cardinal);
  end;

  T32bitarr = array[0..32000] of TRGBA;
  P32bitarr = ^T32bitarr;

procedure TForm1.Button1Click(Sender: TObject);
var    
  bmp1, bmp2: TBitMap;    
  Blend: TBlendFunction;
  i, j : Integer;
  Line : P32bitarr;

begin    
  bmp1 := TBitMap.Create;    
  bmp2 := TBitMap.Create;

  bmp1.LoadFromFile(ExtractFilePath(Application.ExeName) +
                    'Облака.bmp'); // загружаем 1 битмап
  bmp2.LoadFromFile(ExtractFilePath(Application.ExeName) +
                    'img.bmp'); // и второй битмап

  bmp1.PixelFormat := pf32bit; // переводим оба в 32 бит
  bmp2.PixelFormat := pf32bit;

  for j := 0 to bmp2.Height - 1   
  do
    begin
      Line := bmp2.ScanLine[j];
      for i := 0 to bmp2.Width - 1
      do
        if Line[i].Acolor <> 0  //картинку не прозрачной
        then
          Line[i].A := 255;
    end;

  Blend.BlendOp := AC_SRC_OVER;
  Blend.BlendFlags := 0;
  Blend.SourceConstantAlpha := 255; // прозрачность 50% (0 - 255)
  Blend.AlphaFormat := AC_SRC_ALPHA;
  // накладываем битмап 2 на битмап 1
  if Windows.AlphaBlend(bmp1.Canvas.Handle, 0, 0, bmp1.Width, bmp1.Height,    
                                       bmp2.Canvas.Handle, 0, 0, bmp2.Width, bmp2.Height, Blend) then    
    Canvas.Draw(0, 0, bmp1) // рисуем результат на форме
  else ShowMessage(IntToStr(GetLastError)); // или код ошибки, если наложить не удалось    

  bmp1.Free;
  bmp2.Free; // уничтожаем битмапы
end;


для рабочего стола все аналогично, вместо облаков будет фрагмент фона (только его уже не нужно никуда загружать, просто передать Handle (канваса десктопа) вместо первой картинки), а второй битмап будет загруженым. Т.о. будет произведено наложение изображений двух контекстов.

Если не получится буду доделывать дальше (а то так не интересно же програмировать, если все будет готово smile )


--------------------
Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать
PM ICQ Skype   Вверх
Zlo
Дата 16.9.2006, 15:12 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


Профиль
Группа: Участник
Сообщений: 235
Регистрация: 18.9.2004

Репутация: нет
Всего: 1
Чето не могу понять как переделать код чтоб на десктопе рисовать дельфина
PM MAIL   Вверх
Alexeis
Дата 16.9.2006, 16:16 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Амеба
Group Icon


Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 55
Всего: 459
Ладно, вот уже полностью рабочий пример

Код

type
  TRGBA = packed record
           case Byte of
           0: (B, G, R, A : Byte);
           1: (Acolor : Cardinal);
  end;

  T32bitarr = array[0..32000] of TRGBA;
  P32bitarr = ^T32bitarr;

procedure TForm1.Button1Click(Sender: TObject);
var
  bmp: TBitMap;
  Blend: TBlendFunction;
  i, j : Integer;
  Line : P32bitarr;

begin
  bmp := TBitMap.Create;
  bmp.LoadFromFile(ExtractFilePath(Application.ExeName) + 'img.bmp');
  bmp.PixelFormat := pf32bit;  // переводим оба  32 бит

  for j := 0 to bmp.Height - 1
  do
    begin
      Line := bmp.ScanLine[j];
      for i := 0 to bmp.Width - 1
      do
        if Line[i].Acolor <> 0  //картинку не прозрачной
        then
          Line[i].A := 255;
    end;

  Blend.BlendOp := AC_SRC_OVER;
  Blend.BlendFlags := 0;
  Blend.SourceConstantAlpha := 255;
  Blend.AlphaFormat := AC_SRC_ALPHA;
  // накладываем битмап на битмап на рабочий стол
  if not Windows.AlphaBlend(GetDC(GetWindow(GetDesktopWindow, GW_OWNER)),
                        0, 0, bmp.Width, bmp.Height,
                        bmp.Canvas.Handle, 0, 0, bmp.Width, bmp.Height,
                        Blend)

  then ShowMessage(IntToStr(GetLastError));
       // или код ошибки, если наложить не удалось

  bmp.Free;
end;


Это сообщение отредактировал(а) alexeis1 - 16.9.2006, 16:17


--------------------
Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать
PM ICQ Skype   Вверх
Zlo
Дата 16.9.2006, 20:24 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


Профиль
Группа: Участник
Сообщений: 235
Регистрация: 18.9.2004

Репутация: нет
Всего: 1
alexeis1
СПАСИБО БОЛЬШОЕ!!!
PM MAIL   Вверх
  
 Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: Звук, графика и видео"
Girder
Snowy
Alexeis

Запрещено:

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делится вскрытыми компонентами

  • Литературу по Дельфи обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи
  • По вопросам разработки игр стоит заглянуть сюда

FAQ раздела лежит здесь!

Если Вам помогли и атмосфера форума Вам понравилась, то заходите к нам чаще! С уважением, Girder, Snowy.
 
1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: Звук, графика и видео | Следующая тема »

Подписаться на тему | Подписка на этот форум | Скачать/Распечатать тему


 




[ Время генерации скрипта: 0.1256 ]   [ Использовано запросов: 21 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
 По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.