Форум программистов [Powered by Invision Power Board]

Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > Delphi: Общие вопросы > курсор большого размера

Автор: simsmann 27.3.2013, 22:28

Как сделать курсор большого размера. Слинковал файл ресурсов. (использовал Restorator им быстрей) Вводил курсоры разного размера 64х64 128х128 отображаются маленькими.

Автор: simsmann 28.3.2013, 07:28

Не предлагайте установить Image и отслеживать курсор, такой вариант не устраивает. Все должно быть в одном файле. Поэтому загрузка из файла курсоров не устраивает.

Автор: Poseidon 28.3.2013, 08:24

Для начала хотелось бы уточнить зачем?

Автор: simsmann 28.3.2013, 15:02

Необходимо в программе использовать курсор большого размера.

Автор: Akella 28.3.2013, 16:27

Да просто в настройках ОС выберите другой курсор.

Автор: simsmann 28.3.2013, 21:47

курсор для программы

Автор: Akella 28.3.2013, 22:11

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

Автор: Poseidon 29.3.2013, 08:07

Цитата(simsmann @ 28.3.2013, 15:02

)

Необходимо в программе использовать курсор большого размера.

Вопрос был не "Что надо сделать?", а "Зачем?"

Автор: simsmann 29.3.2013, 20:49

Такая программа типа игры где курсор принимант значение различных графических объектов

Добавлено через 5 минут и 37 секунд
function CreateCursor(Instance: THandle; Xhotspot, Yhotspot, Width, Height: Integer; ANDBitPlane, XORBitPlane: Pointer): HCursor

больно муторно и трудоемко для большого размера задавать ANDBitPlane и XORBitPlane

к примеру

const ANDBitPlane : array [1..32, 1..4] of byte =
           ( ($00,$00,$00,$00),
             ($7F,$FF,$FF,$FE),
             .............................

Курсоров много и все большие

Есть какой вариант?

Автор: Чучмек 29.3.2013, 21:29

А почему бы и нет?
Вот. Выводим вручную созданный курсор.

Код


const
 W=256;   //кратно 16
type
 TBitMask=array[0..w-1,0..(W div 8) - 1]of byte;

procedure TForm1.FormCreate(Sender: TObject);
var
 i,j:integer;
 mAND,mXOR:TBitMask;
begin
  for i:=0 to High(mAND) do
  for j:=0 to High(mAND[i]) do
   begin
   if i>High(mAND)   div 2 then mAND[i,j]:=255 else mAND[i,j]:=0;
   if j>High(mAND[i])div 2 then mXOR[i,j]:=255 else mXOR[i,j]:=0;
   end;
Screen.Cursors[100]:=CreateCursor(HInstance,W div 2,W div 2,W,W,@mAND,@mXOR);
Form1.Cursor:=100;
end;

Добавлено через 59 секунд

Цитата(simsmann @ 29.3.2013, 20:49

)

Добавлено через 5 минут и 37 секунд
function CreateCursor(Instance: THandle; Xhotspot, Yhotspot, Width, Height: Integer; ANDBitPlane, XORBitPlane: Pointer): HCursor

больно муторно и трудоемко для большого размера задавать ANDBitPlane и XORBitPlane

к примеру

Блин. Не дочитал.

Автор: bems 29.3.2013, 22:21

Цитата(simsmann @ 29.3.2013, 20:49

)

больно муторно и трудоемко для большого размера задавать ANDBitPlane и XORBitPlane
Курсоров много и все большие
Есть какой вариант?

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

Автор: Illusion Dolphin 30.3.2013, 09:53

Вот пример как просто на основании картинок сделать круглый курсор:

Код




procedure TForm45.FormCreate(Sender: TObject);
begin
  NewCursor;
end;

procedure TForm45.NewCursor;
var
  Rad, CurSize: Integer;
  AndMask: TBitmap;
  IconInfo: TIconInfo;
  Bit: TBitmap;
  Cur: HDC;
begin
  CurSize := 100;

  Bit := TBitmap.Create;
  try
    Bit.PixelFormat := pf1bit;
    Bit.SetSize(CurSize, CurSize);
    Bit.PixelFormat := pf4bit;
    AndMask := TBitmap.Create;
    try
      AndMask.Monochrome := True;
      AndMask.Width := CurSize;
      AndMask.Height := CurSize;
      AndMask.Canvas.Brush.Color := $FFFFFF;
      AndMask.Canvas.Pen.Color := $FFFFFF;
      AndMask.Canvas.FillRect(Rect(0, 0, Bit.Width, Bit.Height));
      Bit.Canvas.Pen.Color := $0;
      Bit.Canvas.Brush.Color := $0;
      Bit.Canvas.FillRect(Rect(0, 0, Bit.Width, Bit.Height));
      Bit.Canvas.Pen.Color := $FFFFFF;
      Bit.Canvas.Ellipse(Rect(0, 0, Bit.Width, Bit.Height));
      IconInfo.FIcon := True;
      IconInfo.XHotspot := 1;
      IconInfo.YHotspot := 1;
      IconInfo.HbmMask := AndMask.Handle;
      IconInfo.HbmColor := Bit.Handle;

      Cur := CreateIconIndirect(IconInfo);
    finally
      AndMask.Free;
    end;
  finally
    Bit.Free;
  end;
  Screen.Cursors[67] := Cur;

  Cursor := 67;
end;

Автор: Чучмек 30.3.2013, 17:23

http://vsokovikov.narod.ru/New_MSDN_API/Resourse/fn_loadimage.htm

Код


h:=LoadImage(0,FileName,IMAGE_CURSOR,0,0,LR_LOADFROMFILE);

Код


h:=LoadImage(HInstance,ResourceName,IMAGE_CURSOR,0,0,0);