В общем, есть проектик, всё было хорошо, пока я не решил его протестить в другой среде. В VMware 4.5 тестировал на винь 2000, в итоге тестирования получил, что данная программа отказывается нормально работать  (вылетает при попытке изменения размера курсора):
| Код |
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, math;
type
TForm1 = class(TForm)
BrushSizeTrackBar: TTrackBar;
procedure BrushSizeTrackBarChange(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
Cur : HIcon;
implementation
{$R *.dfm}
procedure NewCursor;
var
CurSize : integer;
AndMask : TBitmap;
IconInfo : TIconInfo;
bit : TBitmap;
begin
CurSize:=Min(500, Max(2,form1.BrushSizeTrackBar.Position));
bit:=TBitmap.Create;
bit.PixelFormat:=pf1bit;
bit.Width:=CurSize;
bit.Height:=CurSize;
bit.PixelFormat:=pf4bit;
AndMask := TBitmap.Create;
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;
if Cur<>0 then DestroyIcon(Cur); //и без этой строчки пашет
Cur:=0;
Cur:=CreateIconIndirect(IconInfo);
AndMask.free;
bit.Free;
Screen.Cursors[67]:=Cur;
end;
procedure TForm1.BrushSizeTrackBarChange(Sender: TObject);
begin
NewCursor;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
NewCursor;
cursor:=67;
end;
end.
|
В XP всё пашет, в 98 (опять же - из VMware тестил, т.к. постаить операционку семейства 9х у меня уже невозможно (всё давно на нтфс)) вообще эта программа не фурычит. Я бы поставил на виртуальный винь 2000 делфу7 и продебагил, но не получилось (сетап сказал что нет какой-то библиотеки :/)... Гляньте на код создания курсора. может тут что неправильно? А если у кого стоит реальная 2000 - запустите плиз на ней, уж очень интересно... |