本例测试修改光标的形色, 效果图:

unit Unit1;interfaceusesWindows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,Dialogs, StdCtrls, ExtCtrls;typeTForm1 = class(TForm)RadioGroup1: TRadioGroup;procedure FormCreate(Sender: TObject);procedure FormMouseUp(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);procedure RadioGroup1Click(Sender: TObject);procedure FormDestroy(Sender: TObject);end;varForm1: TForm1;implementation{$R *.dfm}varbit: TBitmap;procedure TForm1.FormCreate(Sender: TObject);
constc = '★';
beginRadioGroup1.Caption := '光标形色';RadioGroup1.Items.CommaText := '黑色,灰度,自定义';RadioGroup1.ItemIndex := 0;bit := TBitmap.Create;bit.Canvas.Font.Size := 16;bit.Width := bit.Canvas.TextWidth(c);bit.Height := bit.Canvas.TextHeight(c);bit.Canvas.TextOut(0, 0, c);
end;procedure TForm1.FormDestroy(Sender: TObject);
beginSetCaretBlinkTime(530);bit.Free;
end;procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
varh: HBITMAP;
beginDestroyCaret;h := 0;case RadioGroup1.ItemIndex of1: h := 1;2: h := bit.Handle;end;CreateCaret(Handle, h, 4, 32);SetCaretPos(X,Y);ShowCaret(Handle);
end;procedure TForm1.RadioGroup1Click(Sender: TObject);
varh: HBITMAP;pt: TPoint;
beginGetCaretPos(pt);DestroyCaret;h := 0;case RadioGroup1.ItemIndex of1: h := 1;2: h := bit.Handle;end;CreateCaret(Handle, h, 4, 32);SetCaretPos(pt.X, pt.Y);ShowCaret(Handle);
end;end.

窗体文件:

object Form1: TForm1Left = 0Top = 0Caption = 'Form1'ClientHeight = 137ClientWidth = 228Color = clBtnFaceFont.Charset = DEFAULT_CHARSETFont.Color = clWindowTextFont.Height = -11Font.Name = 'Tahoma'Font.Style = []OldCreateOrder = FalseOnCreate = FormCreateOnDestroy = FormDestroyOnMouseUp = FormMouseUpPixelsPerInch = 96TextHeight = 13object RadioGroup1: TRadioGroupLeft = 137Top = 16Width = 80Height = 113Caption = 'RadioGroup1'TabOrder = 0OnClick = RadioGroup1Clickend
end