zoukankan      html  css  js  c++  java
  • WinAPI: 输入光标相关的函数[3]

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



    代码文件:
    unit Unit1;
    
    interface
    
    uses
      Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
      Dialogs, StdCtrls, ExtCtrls;
    
    type
      TForm1 = 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;
    
    var
      Form1: TForm1;
    
    implementation
    
    {$R *.dfm}
    
    var
      bit: TBitmap;
    
    procedure TForm1.FormCreate(Sender: TObject);
    const
      c = '★';
    begin
      RadioGroup1.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);
    begin
      SetCaretBlinkTime(530);
      bit.Free;
    end;
    
    procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    var
      h: HBITMAP;
    begin
      DestroyCaret;
    
      h := 0;
      case RadioGroup1.ItemIndex of
        1: h := 1;
        2: h := bit.Handle;
      end;
      CreateCaret(Handle, h, 4, 32);
      SetCaretPos(X,Y);
      ShowCaret(Handle);
    end;
    
    procedure TForm1.RadioGroup1Click(Sender: TObject);
    var
      h: HBITMAP;
      pt: TPoint;
    begin
      GetCaretPos(pt);
      DestroyCaret;
    
      h := 0;
      case RadioGroup1.ItemIndex of
        1: h := 1;
        2: h := bit.Handle;
      end;
      CreateCaret(Handle, h, 4, 32);
      SetCaretPos(pt.X, pt.Y);
      ShowCaret(Handle);
    end;
    
    end.
    
    窗体文件:
    object Form1: TForm1
      Left = 0
      Top = 0
      Caption = 'Form1'
      ClientHeight = 137
      ClientWidth = 228
      Color = clBtnFace
      Font.Charset = DEFAULT_CHARSET
      Font.Color = clWindowText
      Font.Height = -11
      Font.Name = 'Tahoma'
      Font.Style = []
      OldCreateOrder = False
      OnCreate = FormCreate
      OnDestroy = FormDestroy
      OnMouseUp = FormMouseUp
      PixelsPerInch = 96
      TextHeight = 13
      object RadioGroup1: TRadioGroup
        Left = 137
        Top = 16
        Width = 80
        Height = 113
        Caption = 'RadioGroup1'
        TabOrder = 0
        OnClick = RadioGroup1Click
      end
    end
    
  • 相关阅读:
    Web Service 其他服务器检测不到查询测试按钮
    设计模式的原则
    适配器模式
    css局部概念的理解:
    编辑并列DIV
    数据可视化 seaborn绘图(1)
    机器学习笔记(3) 随机森林
    机器学习笔记(2) 集成学习 随机森林先导知识
    机器学习笔记(1)决策树
    【转】各种开源协议及其关系
  • 原文地址:https://www.cnblogs.com/del/p/1326386.html
Copyright © 2011-2022 走看看