Форум «Всё о Паскале» > Вопросы по WinApi...

Помощь - Поиск - Пользователи - Календарь

Форум «Всё о Паскале» > Delphi, Assembler и другие языки. > Delphi

Snake_B

6.05.2008 0:31

"Вопросы по WinApi..."

Ковыряюсь во всяких справочниках... чего то ни фига не получается...
Если кто может подскажите, как сделать или где поглядеть пример...

1. CreateWindow ( 'STATIC', text', WS_CHILD or WS_VISIBLE, 30, 8, 500, 80, handleWnd, 0, hInstance, nil );
* как задать ему цвет
* сделать вертикальный скролл
* изменить шрифт (размер, цвет и сам шрифт)

2. Загрузить и показать рисунок (bmp и jpg)...

3. Изменить цвет border color...

4. обработка нажатия кнопки...

лучше всего пример...

andriano

6.05.2008 6:47

Если ты указал один из стандартных классов, то цвет можно изменить только в обработчике WM_PAINT. Если же ты сам регистрируешь класс окна, то там и можешь задать нужную кисть для фона. Вполне естественно, что все окна одного класса выводятся одним цветом.

Вертикальный скролл - добавить WS_VSCROLL в стиль окна.

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

Рисунок проще всего размесить в том же WM_PAINT.

По нажатию кнопки приходит сообщение WM_COMMAND, в параметре WP которого номер нажатой кнопки. Как хочешь, так и обрабатываешь.

Основной источник справки для меня файл Win32.hlp, поставляемый обычно с виндовыми компиляторами. Более подробную информацию можно получить в MSDN.

Еще есть интересная программка http://forum.sources.ru/index.php?showtopic=182219. Она, правда, в явно незаконченном виде, но кое-какие примеры с ее помощью можно посмотреть.

Snake_B

6.05.2008 10:16

А можно всё таки как-нибудь на примере?
Теоретически как бы всё понятно (до того как вопрос задал, догадывался), а на практике сделать не получается...


program WApi;

uses
  Windows,
  Messages,
  ComObj,
  SysUtils,
  ActiveX,
  ShlObj,
  shellapi;

const myClassName= 'myWindow';

var handleWnd: THandle; WndClass: TWndClass; Msg: TMsg;

// Procedure & function >>>>>

function WindowProc(Window: HWnd; AMessage, WParam, LParam: Longint): Longint; stdcall;
begin
    WindowProc:= DefWindowProc(Window, AMessage, WParam, LParam);
    case AMessage of
        WM_DESTROY: Halt;
        WM_PAINT: begin SetBkColor(handleWnd, color_btnface+1); UpdateWindow(handleWnd); end; // ?
        WM_LBUTTONDOWN: Halt; 
        /// Срабатывает при нажатии на форму или на текст, а на нажатие button'а не реагирует...
    end;
end;

// Procedure & function <<<<<
begin
        with WndClass do begin
                hInstance := hInstance;
                lpszClassName:= myClassName;
                style := cs_hRedraw or cs_vRedraw;
                hbrBackground:= color_btnface+2;
                lpfnWndProc := @WindowProc;
                hCursor := LoadCursor(0, idc_Arrow);
        end;
        RegisterClass( WndClass );

        handleWnd := CreateWindow(myClassName, 'Caption...', WS_SYSMENU or WS_MINIMIZEBOX,
                400-300, 300-200, 600, 400, 0, 0, hInstance, NIL);
        CreateWindow('Label', 'Text', WS_VISIBLE or WS_CHILD or WM_SETTEXT,
                20, 10, 60, 23, handleWnd, 0, hInstance, nil);
        CreateWindow('STATIC', 'Borland Studio Projects Borland Studio Projects Borland Studio' + 
                ' Projects Borland Studio ProjectsBorland Studio Projects Borland Studio Projects Borland' + 
                ' Studio Projects Borland Studio Projects', WS_CHILD or WS_VISIBLE + WS_VSCROLL,
                30, 8, 200, 80, handleWnd, 0, hInstance, nil); /// Скролл выводит, но он не работает...
        // SetTextColor(handleWnd, color_btnface+5);
        CreateWindow('BUTTON', '123', WS_VISIBLE or WS_CHILD,
                10, 179, 275, 22, handleWnd, 0, hInstance, nil);

        ShowWindow(handleWnd, sw_ShowNormal); UpdateWindow(handleWnd);
        while GetMessage (Msg, 0, 0, 0) do begin
                TranslateMessage (Msg); DispatchMessage (Msg);
        end;
end.

ну и загрузка/отображение рисунка... исходник бы какой... по проще... :-)

volvo

6.05.2008 13:03

Идея не самая удачная - учиться на том, что в принципе не разрешено: MSDN: Static Control Styles - как видишь, ничего связанного с прокруткой STATIC напрямую не поддерживает. Пользуйся лучше EDIT-ом...

Snake_B

6.05.2008 15:15

Цитата(volvo @ 6.05.2008 22:03)

а в edit'е можно сделать перенос строк? и как...
ну и с остальными так и не разобрался... :-[

volvo

6.05.2008 16:12

Цитата

а в edit'е можно сделать перенос строк? и как...

Легко... Но давай начнем с того, что тебе надо подкорректировать всю программу:

program WinApiTest;

uses
  Windows, Messages;

const
  myClassName= 'myWindow';

  BTN_ID = 200; // ID кнопки

var
  handleWnd, myButton, myLabel, myStatic: HWND;
  myFont: HFONT;

  WndClass: TWndClassEx;
  Msg: TMsg;

// Procedure & function >>
function WindowProc(Window: HWND; AMessage: UINT;
         WParam: WPARAM; LParam: LPARAM): INT_PTR; stdcall;
begin
  case AMessage of
    WM_COMMAND: // Здесь ловим ID нажатой кнопки
    begin
      case LoWord(WParam) of
        BTN_ID: // Вот он, значит, закрываем приложение
        begin
          PostQuitMessage(0);
          Result := 0;
        end;
      end;
    end;

    WM_DESTROY: // Ну, или закрыли крестиком или Alt+F4
    begin
      PostQuitMessage(0);
      Result := 0;
    end;

    else
      // Если ничего не отработало - то вызываем стандартную функцию
      Result := DefWindowProc(Window, AMessage, WParam, LParam);
  end;

end;

// Main Function
begin
  with WndClass do begin
    cbSize := SizeOf(WndClass);
    style := CS_HREDRAW or CS_VREDRAW;
    lpfnWndProc := @WindowProc;
    cbClsExtra := 0;
    cbWndExtra := 0;
    hIcon := LoadIcon(0, IDI_APPLICATION);
    hCursor  := LoadCursor(0, IDC_ARROW);
    hbrBackground := COLOR_BTNFACE + 1;
    lpszMenuName := nil;
    lpszClassName := myClassName;
  end;
  WndClass.hInstance := HInstance;

  if RegisterClassEx(WndClass) = 0 then exit;

  // Создаем окно
  handleWnd := CreateWindow(myClassName, 'Caption...',
      WS_SYSMENU or WS_MINIMIZEBOX,
      100, 100, 600, 400,
      0, 0,
      hInstance, nil);

  ShowWindow(handleWnd, sw_ShowNormal);

  // В этом окне - кнопку ...
  myButton := CreateWindow('button', 'Close',
    WS_VISIBLE or WS_CHILD,
    10, 179, 275, 22,
    handleWnd, BTN_ID, hInstance, nil);
  // ... метку ...
  myLabel := CreateWindow('static', 'Text',
    WS_VISIBLE or WS_CHILD,
    20, 10, 60, 23,
    handleWnd, 0, hInstance, nil);

  // ... и Edit
  myStatic := CreateWindow('edit',
    PChar('Borland Studio Projects Borland Studio Projects '+
          'Borland Studio Projects Borland Studio Projects'+
          'Borland Studio Projects Borland Studio Projects '+
          'Borland Studio Projects Borland Studio Projects '+
          'Borland Studio Projects Borland Studio Projects'+
          'Borland Studio Projects Borland Studio Projects '+
          'Borland Studio Projects Borland Studio Projects '+
          'Borland Studio Projects Borland Studio Projects'+
          'Borland Studio Projects Borland Studio Projects '+
          'Borland Studio Projects Borland Studio Projects'),
    WS_CHILD or WS_VISIBLE or WS_VSCROLL or ES_MULTILINE,
    30, 25, 200, 100, handleWnd, 0, hInstance, nil );

  // Это для красоты - меняем шрифт
  myFont := CreateFont(
    -11, 0, 0, 0, FW_NORMAL, 0, 0, 0, DEFAULT_CHARSET,
    OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY,
    DEFAULT_PITCH or FF_DONTCARE, 'MS Sans Serif'
  );
  SendMessage(myButton, WM_SETFONT, WPARAM(myFont), 0);
  SendMessage(myLabel, WM_SETFONT, WPARAM(myFont), 0);
  SendMessage(myStatic, WM_SETFONT, WPARAM(myFont), 0);

  UpdateWindow(handleWnd);

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

Посмотри, что я изменил, и что из этого получилось... А потом посмотрим, что делать дальше...

Snake_B

7.05.2008 17:14

Цитата(volvo @ 7.05.2008 1:12)

Легко... Но давай начнем с того, что тебе надо подкорректировать всю программу:
...
Посмотри, что я изменил, и что из этого получилось... А потом посмотрим, что делать дальше...


program WinApiTest;

uses Windows, Messages, ComObj, SysUtils, ActiveX, ShlObj, shellapi;

const myClassName= 'myWindow';
      BTN_ID = 200; // ID кнопки
      IDChBox1 = 199;
      IDRBtn1 = 1;
      IDRBtn2 = 2;
      IDRBtn3 = 3;
      IDRBtn4 = 4;

var
      handleWnd, myButton, myLabel, myStatic, ChBox1, RBtn1, RBtn2, RBtn3, RBtn4: HWND;
      WndClass: TWndClassEx;
      Msg: TMsg; SC1, SC2: string; myFont: HFONT;

// Procedure & function
function WindowProc(Window: HWND; AMessage: Integer;
      WParam: WPARAM; LParam: LPARAM): LRESULT; stdcall;
var
  Res: LRESULT;
  p: PChar;
  n: integer;
begin
  case AMessage of
    WM_COMMAND: // Здесь ловим ID нажатой кнопки
    begin
      if ( LoWord( wParam ) >= IDRBtn1 ) and ( LoWord( wParam ) <= IDRBtn2 ) then
            begin CheckRadioButton( handleWnd, IDRBtn1, IDRBtn2, LoWord( wParam ) ); end;
      if ( LoWord( wParam ) >= IDRBtn3 ) and ( LoWord( wParam ) <= IDRBtn4 ) then
            begin CheckRadioButton( handleWnd, IDRBtn3, IDRBtn4, LoWord( wParam ) ); end;
      case LoWord(WParam) of
        BTN_ID: begin PostQuitMessage(0); Result := 0; end;
        IDRBtn1: begin end; // Обработка radiobutton'ов
        IDRBtn2: begin end;
        IDRBtn3: begin end;
        IDChBox1: begin // обработка checkbox'ов
               Res := SendMessage( ChBox1, BM_GETCHECK, 0, 0 );
               case Res of
                  BST_CHECKED: SetWindowText( myLabel, 'Состояние: включен' );
                  BST_UNCHECKED: SetWindowText( myLabel, 'Состояние: выключен' );
               end; end;
      end;
    end;
    WM_DESTROY: // Ну, или закрыли крестиком или Alt+F4
    begin
      PostQuitMessage(0);
      Result := 0;
    end;
    else
      // Если ничего не отработало - то вызываем стандартную функцию
      Result := DefWindowProc(Window, AMessage, WParam, LParam);
  end;
end;

// Procedure & function
begin
  with WndClass do begin
    cbSize := SizeOf(WndClass);
    style := CS_HREDRAW or CS_VREDRAW;
    lpfnWndProc := @WindowProc;
    cbClsExtra := 0;
    cbWndExtra := 0;
    hIcon := LoadIcon(0, IDI_APPLICATION);
    hCursor  := LoadCursor(0, IDC_ARROW);
    hbrBackground := COLOR_BTNFACE + 1;
    lpszMenuName := nil;
    lpszClassName := myClassName;
  end;
  WndClass.hInstance := HInstance;

  if RegisterClassEx(WndClass) = 0 then exit;

  handleWnd:= CreateWindow(myClassName, 'Caption...', WS_SYSMENU or WS_MINIMIZEBOX,
    400-300,300-200, 600, 400, 0, 0, hInstance , NIL);
  CreateWindow( 'Label', 'Text', WS_VISIBLE or WS_CHILD or WM_SETTEXT,
    300, 152, 60, 23, handleWnd, 0, hInstance, nil);
  ShowWindow(handleWnd, sw_ShowNormal);

  myButton := CreateWindow('button', 'Close', WS_VISIBLE or WS_CHILD,
    10, 179, 275, 22, handleWnd, BTN_ID, hInstance, nil);
  myLabel := CreateWindow('static', 'Text', WS_VISIBLE or WS_CHILD,
    20, 10, 120, 14, handleWnd, 0, hInstance, nil);
  myStatic := CreateWindow('edit',
    PChar('Borland Studio Projects Borland Studio Projects Borland Studio Projects Borland Studio Projects'+
          'Borland Studio Projects Borland Studio Projects Borland Studio Projects Borland Studio Projects '+
          'Borland Studio Projects Borland Studio Projects Borland Studio Projects Borland Studio Projects '+
          'Borland Studio Projects Borland Studio Projects Borland Studio Projects Borland Studio Projects'+
          'Borland Studio Projects Borland Studio Projects Borland Studio Projects Borland Studio Projects'),
    WS_CHILD or WS_VISIBLE or WS_VSCROLL or ES_MULTILINE + WS_BORDER,
    30, 25, 200, 100, handleWnd, 0, hInstance, nil );

  CreateWindow('STATIC', PChar('|||||||||||||||||||||||||||||||||||||||||||||||||'),
    WS_CHILD or WS_VISIBLE or WS_BORDER + es_readonly,
    100, 280, 400, 21, handleWnd, 0, hInstance, nil );

  ChBox1 := CreateWindowEx( 0, 'Button', 'BS_AUTOCHECKBOX',
    WS_CHILD or WS_VISIBLE or BS_AUTOCHECKBOX, 300, 10, 130, 25,
    handleWnd, IDChBox1, hinstance, nil );
  RBtn1 := CreateWindowEx( 0, 'Button', 'Опция 1',
    WS_CHILD or WS_VISIBLE or BS_RADIOBUTTON, 300, 40, 80, 20,
    handleWnd, IDRBtn1, hInstance, nil );
  RBtn2 := CreateWindowEx( 0, 'Button', 'Опция 2',
    WS_CHILD or WS_VISIBLE or BS_RADIOBUTTON, 300, 70, 80, 20,
    handleWnd, IDRBtn2, hInstance, nil );
  RBtn3 := CreateWindowEx( 0, 'Button', 'Опция 3',
    WS_CHILD or WS_VISIBLE or BS_RADIOBUTTON, 300, 120, 80, 20,
    handleWnd, IDRBtn3, hInstance, nil );
  RBtn4 := CreateWindowEx( 0, 'Button', 'Опция 4',
    WS_CHILD or WS_VISIBLE or BS_RADIOBUTTON, 300, 150, 80, 20,
    handleWnd, IDRBtn4, hInstance, nil );

  myFont:= CreateFont(-11, 0, 0, 0, FW_NORMAL, 0, 0, 0,
    DEFAULT_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS,
    DEFAULT_QUALITY, DEFAULT_PITCH or FF_DONTCARE, 'MS Sans Serif');
  SendMessage(myButton, WM_SETFONT, WPARAM(myFont), 0);
  SendMessage(myLabel, WM_SETFONT, WPARAM(myFont), 0);
  SendMessage(myStatic, WM_SETFONT, WPARAM(myFont), 0);
  SendMessage( ChBox1, WM_SETFONT, WPARAM(myFont), 0 );
  SendMessage( RBtn1, WM_SETFONT, WPARAM(myFont), 0 );
  SendMessage( RBtn2, WM_SETFONT, WPARAM(myFont), 0 );
  SendMessage( RBtn3, WM_SETFONT, WPARAM(myFont), 0 );
  SendMessage( RBtn4, WM_SETFONT, WPARAM(myFont), 0 );

  SendMessage( RBtn1, BM_CLICK, 0, 0 ); SendMessage( RBtn3, BM_CLICK, 0, 0 );
  // Нажимаем radiobutton, для инициализации...

  UpdateWindow(handleWnd);
  while GetMessage (Msg, 0, 0, 0) do begin 
    TranslateMessage (Msg); DispatchMessage (Msg);
  end;

end.

Спасибо, многое вроде понял :-)
но вопросики остались :-[

Поле Edit... мне нужно туда выводить текст, скролл если текст влазить не будет,
но этот текст должно быть нельзя редактировать.

es_readonly

- почти то что нужно, но меняется цвет, а нужен всё таки белый...
как изменить цвет или как по другому сделать можно, это 1.

2. Ну всё также, загрузка/показ рисунка... ни где так примера и не нашел...

3. Можно ли вызвать стандартный progress bar.... там я в исходнике в принципе набросал из STATIC'а...
но стандартным симпотичнее было бы...

Вроде кроме этого вопросов возникнуть не должно :-)

p.s. там если в исходнике чего лишнего... я его не целиком выкладываю... кое-что удаляю... все равно там всё тоже самое... но огрызки остаются...

volvo

7.05.2008 18:08

Цитата

Можно ли вызвать стандартный progress bar

Можно:

  // Создаем прогрессбар
  myProgress := CreateWindow('msctls_progress32', '', WS_CHILD or WS_VISIBLE,
    250, 20, 300, 30, handleWnd, 0, HInstance, nil);
  // устанавливаем границы
  SendMessage(myProgress, PBM_SETRANGE, 0, MAKELPARAM(0, 100));

Вот так посылаем прогресс-бару сообщения:

...
      case LoWord(WParam) of
        BTN_ID: // По нажатию кнопки перед закрытием, отобразим Progress...
        begin
          for i := 0 to 100 do begin
            Sleep(50);
            SendMessage(myProgress, PBM_SETPOS, i, 0);
          end;
          PostQuitMessage(0);
          Result := 0;
        end;
...

Необходимые константы:

Const
  PBM_SETRANGE = WM_USER + 1;
  PBM_SETPOS = WM_USER + 2;
  PBM_STEPIT = WM_USER + 5;

Цитата

Ну всё также, загрузка/показ рисунка... ни где так примера и не нашел...

Вот тебе пример:

var 
  StaticWnd: HWND;
  ImLogo: HBITMAP;
...
   // Создаем статический контрол
   StaticWnd := CreateWindow('static', 'Test',
        WS_VISIBLE or WS_CHILD or SS_BITMAP or SS_CENTERIMAGE,
        100, 100, 500, 300, handleWnd, 0, HInstance, nil);
   // Грузим в битмап содержимое BMP-файла
   ImLogo := LoadImage(0, 'real_map.bmp', IMAGE_BITMAP, 0, 0,
        LR_LOADFROMFILE or LR_LOADMAP3DCOLORS or LR_LOADTRANSPARENT);
   // И посылаем стат. контролу сообщение об установке изображения
   SendMessage(StaticWnd, STM_SETIMAGE, IMAGE_BITMAP, ImLogo);

Насчет неизменяемого EDIT-а сейчас гляну...

Добавлено через 9 мин.
P.S. А, ну так не надо делать ES_READONLY, достаточно написать ничего не делающую оконную функцию:

var
  OldEditProc: Pointer;

function myEditProc(Window: HWND; AMessage: UINT;
         WParam: WPARAM; LParam: LPARAM): INT_PTR; stdcall;

begin
  Case AMessage of
    WM_CHAR: Result:=0;
    WM_LBUTTONDOWN: Result:=0;
    WM_RBUTTONDOWN: Result:=0;
  else Result:=CallWindowProc(OldEditProc, Window, AMessage, WParam, LParam);
  end;
end;

// и после создания EDIT-а подменить стандартную оконную функцию новой:

... // Здесь создаем myStatic

// и подменяем функцию окна
OldEditProc:=Pointer(SetWindowLong(myStatic,GWL_WNDPROC,LongInt(@myEditProc)));

Snake_B

7.05.2008 22:46

Цитата(volvo @ 8.05.2008 3:08)

Можно:

  // Создаем прогрессбар
  myProgress := CreateWindow('msctls_progress32', '', WS_CHILD or WS_VISIBLE,
    250, 20, 300, 30, handleWnd, 0, HInstance, nil);
  // устанавливаем границы
  SendMessage(myProgress, PBM_SETRANGE, 0, MAKELPARAM(0, 100));

Вот так посылаем прогресс-бару сообщения:

...
      case LoWord(WParam) of
        BTN_ID: // По нажатию кнопки перед закрытием, отобразим Progress...
        begin
          for i := 0 to 100 do begin
            Sleep(50);
            SendMessage(myProgress, PBM_SETPOS, i, 0);
          end;
          PostQuitMessage(0);
          Result := 0;
        end;
...

Необходимые константы:

Const
  PBM_SETRANGE = WM_USER + 1;
  PBM_SETPOS = WM_USER + 2;
  PBM_STEPIT = WM_USER + 5;

Всё вроде понятно... но вот прогресс бар не хотит работать... не знаю чему :-)

p.s. с jpeg'ом тоже разобрался... стандартно... но размер exe сразу за 250 кб перевалил..

volvo

7.05.2008 23:17

Цитата

прогресс бар не хотит работать... не знаю чему :-)

Хочешь - вот проект полностью - у меня все работает (Delphi 2007 + WinXP SP2), компилируй, запускай (только свою картинку проставь, у меня уж очень большая, чтоб ее вывешивать)...

Snake_B

8.05.2008 0:05

Цитата(volvo @ 8.05.2008 8:17)

тоже ни чего... странно...

и ещё вопросик... как правильно с формами работать..
т.е.
создаю форму,
надо удалить и создать другую...

оно то работает, то программа закрывается.. не могу толком разобратся...
ну или как изменить размеры формы..

volvo

8.05.2008 0:22

Цитата

тоже ни чего... странно...

Что значит "Ничего"? Программа запустилась? Окно отрисовала? Картинку вывела? На кнопку нажал? Что произошло? Закрылось? Сразу, или с задержкой? Версия Windows и Delphi какая?

Это все я должен спрашивать, или ты мог сам догадаться рассказать? Невозможно локализовать ошибку, когда ты молчишь, как партизан: "не работает и все"... Ну, не работает, значит делай, чтоб работало... Программа в конце концов нужна тебе... У меня все отрабатывает.

Цитата

оно то работает, то программа закрывается.. не могу толком разобратся...

Что "ОНО"? Это я тоже должен догадаться, как ты реализовал, и что у тебя там происходит?

Snake_B

8.05.2008 0:31

Цитата(volvo @ 8.05.2008 9:22)

действительно... :-[
1. Окно отрисовало, картинка есть, кнопку нажал..
окно закрылось, с задержкой... но прогресс бар не отрисовало....
всё остальное есть, его нету... визуально...

delphi 2005 + win xp sp2

2. После первой формы надо создать вторую (это я сделал),
а первую надо удалить, делаю "destroywindow(handleWindow);"
программа закрывается полостью.
Добавлял форму вторую, вроде работало, уничтажалась первая,
программа работала дальше... потом вынес создание форм в процедуры
закрывается при уничтожении любой из форм (и первой и второй)...

может исходник положить?

andriano

8.05.2008 6:10

А ты уверен что тебе нужно их именно уничтожать?
Скрыть (сделать, что б не рисовались) недостаточно?

Snake_B

8.05.2008 8:52

Цитата(andriano @ 8.05.2008 15:10)

А ты уверен что тебе нужно их именно уничтожать?
Скрыть (сделать, что б не рисовались) недостаточно?

Да в принципе лучше всего использовать одно, только менять его размеры...
function SetWindowPos(Wnd, WndInsertAfter: HWnd; X, Y, cx, cy:
может быть так... только у меня не получается :-)

volvo

8.05.2008 10:08

Цитата

окно закрылось, с задержкой... но прогресс бар не отрисовало....

Хочешь, я присоединю исходник, проверишь его, больше ничего сказать не могу, проверял на 4-х машинах, везде все в порядке...

Цитата

может быть так... только у меня не получается

Вот так - получается:

SetWindowPos(handleWnd, 0, 0, 0, 700, 600, SWP_NOMOVE or SWP_NOZORDER);

Snake_B

8.05.2008 14:47

Цитата(volvo @ 8.05.2008 19:08)

Хочешь, я присоединю исходник, проверишь его, больше ничего сказать не могу, проверял на 4-х машинах, везде все в порядке...

Вот так - получается:

SetWindowPos(handleWnd, 0, 0, 0, 700, 600, SWP_NOMOVE or SWP_NOZORDER);

Спасибо...
А по прогресс бару... ну и ладно... без него сделаю.. не критично...
В основном пока всё... но мне кажется будет ещё пару тройку вопросов по позже :-)

andriano

8.05.2008 18:32

Цитата(Snake_B @ 8.05.2008 15:47)

А по прогресс бару... ну и ладно... без него сделаю.. не критично...

Вообще-то все, что нужно, можно сделать ручками.
Что-то мне не понравилось в стандартной прогрессбар, сделал свою.

Snake_B

11.05.2008 22:55

Цитата(andriano @ 9.05.2008 3:32)

не знаю... чего то не сильно получается... можно все файлы выложить? как в "TESTFNT2.exe"...
а то у меня подозрение... что и этот не работает... или у меня руки кривые...
и к Вольво тоже вопросик... пример с progressbar... exe-шник можно выложить?
ну или на мыло...

это по прогресс бару...
и новый вопросик.. есть у меня там ListBox...

indexLB:= SendMessage(ListB1, LB_GETCURSEL, 0, 0);

вот так достаю номер выделенной строки... а как мне достать содержание этой строки?

volvo

11.05.2008 23:11

Цитата

а как мне достать содержание этой строки?

var
  ListB1: HWND;
  i, len: integer;
  buffer: string;

...

  len := SendMessage(ListB1, LB_GETTEXTLEN, i, 0); // i - номер строки
  SetLength(Buffer, len); // достаточное место для хранения данных
  SendMessage(ListB1, LB_GETTEXT, i, integer(PChar(Buffer))); // получаем данные
...

Вот EXE-шник: Нажмите для просмотра прикрепленного файла
(только там теперь по нажатию на кнопку отрабатывает ProgressBar и размер формы меняется, закрывать форму придется "крестиком")...

Snake_B

12.05.2008 0:48

Цитата(volvo @ 12.05.2008 8:11)

спасибо, по листбоксу...
а прогрессбар в exe не показывает... уже тему поменял на стандартную и всё равно...
он в общем не сильно нужен...
но глюк интересный...

П.С. ещё одни вопросик нарисовался...

   
WM_DESTROY: begin
            if MessageBox(handleW1, 'Подтверждение...', 'хотите выйти ?',  
            MB_OkCancel+MB_IconAsterisk+mb_systemmodal)= idCancel then exit;
       PostQuitMessage(0); 
       Result := 0; 
end; // Ну, или закрыли крестиком или Alt+F4

После показа messageBox'а скрывается основная форма... а это не нужно...
можно это исправить?

volvo

12.05.2008 8:54

Цитата

После показа messageBox'а скрывается основная форма... а это не нужно...

Естественно... Окно получает сообщение WM_DESTROY тогда, когда уже не может отменить закрытие, ты отменяешь только уничтожение окна... Закрывается оно еще перед вызовом MessageBox-а... Тебе надо обрабатывать WM_CLOSE, чтоб иметь возможность отменять закрытие окна:

    WM_CLOSE:
    begin
      // если все-таки хочешь выйти, значит удалить-таки окно: DestroyWindow
      if MessageBox(handleWnd, 'Подтверждение...', 'хотите выйти ?',
        MB_OKCANCEL + MB_ICONASTERISK + MB_SYSTEMMODAL) = IDOK then DestroyWindow(handleWnd);
    end;

Snake_B

12.05.2008 11:31

Цитата(volvo @ 12.05.2008 17:54)

Естественно... Окно получает сообщение WM_DESTROY тогда, когда уже не может отменить...

С этим понятно...
Вот пытаюсь тут по FAQ (drkb), статья: "Сохранение и выдёргивание ресурсов в DLL или EXE? "
сохранить ресурс в exe... ресурс создал, в exe он судя по размеру тоже добавляется,
а когда пытаюсь его извлечь выдает: "Resourse 1 not found"

procedure ExtractToFile(Instance:THandle; ResID:Integer; ResType, FileName:String);
var ResStream: TResourceStream; FileStream: TFileStream;
begin
  try ResStream := TResourceStream.CreateFromID(Instance, ResID, pChar(ResType));
    try if FileExists(FileName) then DeleteFile(pChar(FileName));
        FileStream := TFileStream.Create(FileName, fmCreate);
    try FileStream.CopyFrom(ResStream, 0); finally
        FileStream.Free; end;
    finally ResStream.Free; end;
  except on E:Exception do begin
      DeleteFile(FileName); raise;
end; end; end;

...
ExtractToFile(handleW1, 1, 'CUSTOM', ExtractFiledir(paramStr(0))+'/Source SMP/LogoSI.bmp');

p.s. вот тут файлик прикрепляю... так создаю и извлекаю..
всё тоже: "Resourse 1 not found"
чего не так?

volvo

16.05.2008 12:28

У меня вот так прекрасно отработало:

// Внимание на типы!!! ResType я сделал Integer-ом!!!
procedure ExtractToFile(Instance:THandle;
          ResID, ResType: integer; FileName:String);
var
  ResStream: TResourceStream;
  FileStream: TFileStream;
begin
  try
    ResStream := TResourceStream.CreateFromID(Instance, ResID, PChar(ResType));
    try
      if FileExists(FileName) then DeleteFile(pChar(FileName));
      FileStream := TFileStream.Create(FileName, fmCreate);
      try
        FileStream.CopyFrom(ResStream, 0);
      finally
        FileStream.Free;
      end;

    finally
      ResStream.Free;
    end;

    except on E:Exception do begin
      DeleteFile(FileName); raise;
    end;
  end;
end;

...

  // вместо Application.Handle лучше использовать HInstance...
  ExtractToFile(HInstance, 1, 10, ExtractFiledir(paramStr(0))+'\pic_new.bmp');

(к вопросу, почему именно целочисленная 10, а не 'CUSTOM': При преобразовании этой 10 к типу PChar в процедуре получим как раз PChar(10), что соответствует RT_RCDATA... Как записывали в ресурс, так надо и извлекать...)

Snake_B

16.05.2008 21:57

Цитата(volvo @ 16.05.2008 21:28)

У меня вот так прекрасно отработало...

Спасибо, заработало... вроде :-)

И ещё вопросик :-[

function ChangeDirectory(): pchar;
var 
TitleName : string; 
lpItemID : PItemIDList; 
BrowseInfo : TBrowseInfo; 
DisplayName : array[0..MAX_PATH] of char;
begin
  FillChar(BrowseInfo, sizeof(TBrowseInfo), #0);
  BrowseInfo.hwndOwner := handleW1;
  BrowseInfo.pszDisplayName := @DisplayName;
  TitleName := 'Please specify a directory';
  BrowseInfo.lpszTitle := PChar(TitleName);
  BrowseInfo.ulFlags := BIF_RETURNONLYFSDIRS;
  lpItemID := SHBrowseForFolder(BrowseInfo);
        if lpItemId <> nil then begin
            SHGetPathFromIDList(lpItemID, result);
            GlobalFreePtr(lpItemID);
        end; 
end;

.....

sc1:=ChangeDirectory;

Вот, вызываю функцию... выбор папки... Если длинна выбранного пути > 38 (~),
то появляется ошибка...
что посоветуете? :-)

volvo

16.05.2008 22:41

Вообще-то когда работаешь с PChar, надо быть осторожнее... Лучше сделай так:

function ChangeDirectory(): String;
var 
  TitleName : string; 
  lpItemID : PItemIDList; 
  BrowseInfo : TBrowseInfo; 
  DisplayName : array[0..MAX_PATH] of char;
  TempName: Array[0 .. MAX_PATH] of char;
begin
  FillChar(BrowseInfo, sizeof(TBrowseInfo), #0);
  BrowseInfo.hwndOwner := form1.Handle; // ну, или что там у тебя ...
  BrowseInfo.pszDisplayName := @DisplayName;
  TitleName := 'Please specify a directory';
  BrowseInfo.lpszTitle := PChar(TitleName);
  BrowseInfo.ulFlags := BIF_RETURNONLYFSDIRS;
  lpItemID := SHBrowseForFolder(BrowseInfo);
        if lpItemId <> nil then begin
            SHGetPathFromIDList(lpItemID, TempName);
            result := strpas(TempName);
            GlobalFreePtr(lpItemID);
        end;
end;

Snake_B

24.05.2008 10:53

Новый вопросик... и мне кажется он где-то близко к progressbar'у...


procedure ChangeLPB(value: integer); 
var 
i: integer; 
s: string; 
begin 
s:=' '; 
for i := 0 to value do s:=s+'|';
s:=s+' '; 
SetWindowText( mS2, PChar(s)); 
end;

................

  // создаю текст...
  mS2:= CreateWindow('STATIC', '', WS_CHILD or WS_VISIBLE or WS_BORDER + es_readonly,
    6, 180, 308, 21, handleW1, 0, hInstance, nil ); 
  SendMessage(mS2, WM_SETFONT, WPARAM(mF3), 0);

   for i := 0 to 99 do begin
   Sleep(50);
   ChangeLPB(i);
   end;

while GetMessage (Msg1, 0, 0, 0) do begin
  TranslateMessage (Msg1); DispatchMessage (Msg1);
end;

как дать команду отрисовать текст пред for...

Snake_B

25.07.2008 3:12

Цитата(Snake_B @ 24.05.2008 19:53)

Новый вопросик... и мне кажется он где-то близко к progressbar'у...

...

как дать команду отрисовать текст пред for...

туплю чего то :-)
UpdateWindow(handleW1);

и прогрессбар заработал... винду не переустанавливал... вообще вроде ни чего такого с компом не делал...

Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.