VPF::картинка на форме - Форум программистов

BLACK_KOT

Дата 17.5.2009, 08:41 (ссылка)

(нет голосов)

Загрузка ...

Опытный

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

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

пишу на winapi.
создаю форму:

Код


  with WCl do
    begin
      lpszClassName:='cln';
      lpfnWndProc:=@WndProc;
      hCursor:=LoadCursor(hInstance, IDC_ARROW);
      hbrBackground:=COLOR_3DSHADOW;
    end;
RegisterClass(WCl);
W:=CreateWindowEx(WS_EX_TOPMOST, 'cln', 'BLACK_KOT''s program', WS_VISIBLE or WS_POPUPWINDOW, 200, 200, 218, 230, 0, 0, hInstance, nil);

вопрос: как мне картинку поместить на форму?
иль мне каждый пиксель при перерисовке отрисовывать вручную?

Это сообщение отредактировал(а) BLACK_KOT - 17.5.2009, 09:03

--------------------

.. я - демо версия Бога от Microsoft..

Keeper89

Дата 17.5.2009, 14:52 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 2580
Регистрация: 26.2.2009

Репутация: 14
Всего: 58

Вот вариант:

Код


function LoadBitmapFromBMPFile(szFileName: LPTSTR;
                               var phBitmap: HBITMAP): BOOL;
begin

   phBitmap := LoadImage(0, szFileName, IMAGE_BITMAP, 0, 0,
               LR_CREATEDIBSECTION or LR_DEFAULTSIZE or LR_LOADFROMFILE);
   if phBitmap = 0 then
   begin
     Result := False;
     Showmessage('Не удалось загрузить картинку!');
   end
   else
     Result := True;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  hNewBitmap: HBITMAP;
  hMemDC: HDC;
  bm: BITMAP;
begin

  if LoadBitmapFromBMPFile('C:\1.bmp', hNewBitmap) then
  begin
    GetObject(hNewBitmap, sizeof(BITMAP), @bm);
    hMemDC := CreateCompatibleDC(0);
    SelectObject(hMemDC, hNewBitmap);
    BitBlt(Canvas.Handle, 0, 0, bm.bmWidth, bm.bmHeight,
           hMemDC, 0, 0, SRCCOPY);
    DeleteObject(hNewBitmap);
  end;
end;

Это сообщение отредактировал(а) Keeper89 - 17.5.2009, 15:16

--------------------

Cogito, ergo sum

Keeper's blog
CnWizards Downloads

user posted image

BLACK_KOT

Дата 17.5.2009, 18:12 (ссылка)

(нет голосов)

Загрузка ...

Опытный

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

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

код неплохой, но в winapi вместо канваса приходится подставлять

Код


h:=GetDC(hnd);
   
 BitBlt( h, 0, 0, bm.bmWidth, bm.bmHeight,hMemDC, 0, 0, SRCCOPY);

где hnd - моё созданное окно.

и этот код не рабэ. видать потому что не то подставляю.
мож подскажеш?

--------------------

.. я - демо версия Бога от Microsoft..

Keeper89

Дата 17.5.2009, 19:17 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 2580
Регистрация: 26.2.2009

Репутация: 14
Всего: 58

BLACK_KOT, напиши полный код создания окна, потому что

Код


    myDC := GetDC(Handle);
    BitBlt(myDC, 0, 0, bm.bmWidth, bm.bmHeight,
           hMemDC, 0, 0, SRCCOPY);

прекрасно работает.

P.S. И пиши по-русски, надоело уже твой "афроамериканский сленг" переводить.

Это сообщение отредактировал(а) Keeper89 - 17.5.2009, 19:26

--------------------

Cogito, ergo sum

Keeper's blog
CnWizards Downloads

user posted image

BLACK_KOT

Дата 17.5.2009, 21:19 (ссылка)

(нет голосов)

Загрузка ...

Опытный

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

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

Код


program BLACK_KOT;

uses
  Messages,
  Windows,mmsystem;

{$R 1.res} {$R music.res}

var
W, Button1,edit1,label1,label2,CheckBox1: HWND;
WCl: TWndClass;
Msg: TMsg;


function LoadBitmapFromBMPFile(szFileName: LPTSTR;
                               var phBitmap: HBITMAP): BOOL;
begin

   phBitmap := LoadImage(0, szFileName, IMAGE_BITMAP, 0, 0,
               LR_CREATEDIBSECTION or LR_DEFAULTSIZE or LR_LOADFROMFILE);
   if phBitmap = 0 then
   begin
     Result := False;
     beep(100,100);
   end
   else
     Result := True;
end;




//--------------------------обработка сообщений для CheckBox1
function chbProc(hWnd: HWND; Msg: UINT;wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
begin
  case Msg of
   WM_LBUTTONDOWN:
    begin


    end;
  end;

Result := CallWindowProc(Pointer(GetWindowLong(hWnd, GWL_USERDATA)),hWnd, Msg, wParam, lParam);
end;



//--------------------------обработка сообщений для edit1
function EditProc(hWnd: HWND; Msg: UINT;wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
begin
  case Msg of
  WM_LBUTTONDOWN:
    begin

    end;
  end;

Result := CallWindowProc(Pointer(GetWindowLong(hWnd, GWL_USERDATA)),hWnd, Msg, wParam, lParam);
end;

//--------------обработка сообщений для кнопки
function Button1Proc(hWnd: HWND; Msg: UINT;wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
begin
  case msg of
  WM_LBUTTONUP: PostQuitMessage(0);
  end;
Result := CallWindowProc(Pointer(GetWindowLong(hWnd, GWL_USERDATA)),hWnd, Msg, wParam, lParam);
end;


procedure timer;
var
  PMyMid: pointer;
  HMyMid: THandle;
begin
  HMyMid := FindResource(hInstance, 'rcdata_0',RT_RCDATA);
  HMyMid := LoadResource(hInstance, HMyMid);
  PMyMid := LockResource(HMyMid);
  sndPlaySound(PMyMid, snd_Memory or SND_ASYNC);
  UnlockResource(HMyMid);
  FreeResource(HMyMid);
end;


//--------------------главный обработчик сообщений
  function WndProc(hnd, wmsg, wparam, lparam: integer): integer; stdcall;
  var h:hdc;

  hNewBitmap: HBITMAP;
  hMemDC: HDC;
  bm: BITMAP;

  begin
  Result:=0;
  case wmsg of
     WM_CREATE:
      begin
      label1:=CreateWindowEx(WS_EX_DLGMODALFRAME,'STATIC','BLACK_KOT''s program', WS_VISIBLE or WS_CHILD,0,0,192,22,hnd, 0, hInstance, nil);
      label2:=CreateWindowEx(0 ,'STATIC','  Введите анаграмму',WS_VISIBLE or WS_CHILD,3,25,75,35, hnd, 0, hInstance, nil);

      Button1:=CreateWindowEx(BS_RIGHTBUTTON, 'BUTTON', 'X', WS_TABSTOP or WS_VISIBLE or WS_CHILD, 194, 1, 21, 21, hnd, 0, hInstance, nil);
      SetWindowLong(Button1, GWL_USERDATA,SetWindowLong(Button1, GWL_WNDPROC, LongInt(@Button1Proc)));

      Edit1 := CreateWindowEx(0, 'Edit', '',ws_BORDER or WS_CHILD or WS_VISIBLE or ES_LEFT or ES_AUTOhSCROLL,85,30,125,20,  hnd, 0, HInstance, nil);
      SetWindowLong(Edit1, GWL_USERDATA,SetWindowLong(Edit1, GWL_WNDPROC, LongInt(@EditProc)));

      CheckBox1:= CreateWindowEx(0, 'Button', 'checkbox',WS_CHILD or WS_VISIBLE or BS_AUTOCHECKBOX,25,70,90,14,  hnd, 0, HInstance, nil);
      SetWindowLong(CheckBox1, GWL_USERDATA,SetWindowLong(CheckBox1, GWL_WNDPROC, LongInt(@chbProc)));


      timer;
      setTimer(hnd,100,7450,nil); // TIMER !!

      if LoadBitmapFromBMPFile('C:\1.bmp', hNewBitmap) then
        begin
        GetObject(hNewBitmap, sizeof(BITMAP), @bm);
        hMemDC := CreateCompatibleDC(0);
        SelectObject(hMemDC, hNewBitmap);
        h:=GetDC(hnd);
        //beep(958,100);
        BitBlt( h, 0, 0, bm.bmWidth, bm.bmHeight,hMemDC, 0, 0, SRCCOPY);
        DeleteObject(hNewBitmap);
        end;
      end;
    WM_TIMER: timer;


    WM_LBUTTONDOWN: SendMessage(W,WM_SYSCOMMAND,$F012, 0); //таскаем форму

    WM_CTLCOLOREDIT:
      begin
        { Устанавливаем цвет шрифта }
        SetTextColor(wParam,$0000ff);
      end;
    WM_DESTROY: PostQuitMessage(0);



  else Result:=DefWindowProc(hnd, wmsg, wparam, lparam);
  end;
  end;

Procedure CreateMySelf;
begin
  with WCl do
    begin
      lpszClassName:='cln';
      lpfnWndProc:=@WndProc;
      hCursor:=LoadCursor(hInstance, IDC_ARROW);
      hbrBackground:=COLOR_3DSHADOW;
    end;
RegisterClass(WCl);
W:=CreateWindowEx(WS_EX_TOPMOST, 'cln', 'BLACK_KOT''s program', WS_VISIBLE or WS_POPUPWINDOW, 200, 200, 218, 230, 0, 0, hInstance, nil);
SetFocus(edit1);
end;

begin
CreateMySelf;
while GetMessage(Msg, 0, 0, 0) do
  begin
  TranslateMessage(Msg);
  DispatchMessage(Msg);
  end;
end.

Это сообщение отредактировал(а) BLACK_KOT - 17.5.2009, 21:21

--------------------

.. я - демо версия Бога от Microsoft..

Keeper89

Дата 17.5.2009, 23:56 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 2580
Регистрация: 26.2.2009

Репутация: 14
Всего: 58

Код


var
  hW: HWND;
...
    W := CreateWindowEx(WS_EX_TOPMOST, 'cln', 'BLACK_KOT''s program', 
             WS_VISIBLE or WS_POPUPWINDOW, 200, 200, 218, 230, 0, 0, hInstance, nil);
    hW := GetDC(W);
    BitBlt(hW, 0, 0, bm.bmWidth, bm.bmHeight,
             hMemDC, 0, 0, SRCCOPY);
...

Это сообщение отредактировал(а) Keeper89 - 17.5.2009, 23:57

--------------------

Cogito, ergo sum

Keeper's blog
CnWizards Downloads

user posted image

BLACK_KOT

Дата 22.5.2009, 01:25 (ссылка)

(нет голосов)

Загрузка ...

Опытный

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

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

ОГРОМНОЕ СПАСИБО, ВСЁ РАБОТАЕТ!

--------------------

.. я - демо версия Бога от Microsoft..

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: WinAPI и системное программирование \| Следующая тема »