...einen eigenen Textcursor verwenden?

Autor: Igor Siticov
Homepage: http://www.sicomponents.com

Kategorie: Grafik

{
  The example below demonstrates creating custom caret:
  Das Beispiel zeigt, wie ein eigener Cursor verwendet werden kann:
}

unit Unit1;

interface

uses
  
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls;

type
  
TForm1 = class(TForm)
    Memo1: TMemo;
    Image1: TImage;
    Edit1: TEdit;
    procedure Memo1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Edit1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    
{ Private declarations }
  
public
    
{ Public declarations }
  
end;

var
  
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Memo1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  
CreateCaret(Memo1.Handle, Image1.Picture.Bitmap.Handle, 0, 0);
  ShowCaret(Memo1.Handle);
end;

procedure TForm1.Edit1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  
CreateCaret(Edit1.Handle, 0, 10, 4);
  ShowCaret(Edit1.Handle);
end;

end.


{The form file source (*.dfm) }

object Form1: TForm1
  Left = 192
  Top = 107
  Width = 544
  Height = 375
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object Image1: TImage
    Left = 12
    Top = 4
    Width = 16
    Height = 16
    AutoSize = True
    Picture.Data = {
      07544269746D6170B6020000424DB602000000000000B6000000280000001000
      0000100000000100100000000000000200000000000000000000100000000000
      000000000000000080000080000000808000800000008000800080800000C0C0
      C000808080000000FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFF
      FF00000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
      000000000000FF7FFF7FFF7FFF7F000000000000FF7FFF7FFF7FFF7FFF7FFF7F
      00000000FF7FFF7FFF7FFF7F000000000000FF7FFF7FFF7FFF7FFF7FFF7F0000
      0000FF7FFF7FFF7FFF7FFF7F00000000FF7FFF7FFF7FFF7FFF7FFF7FFF7F0000
      000000000000FF7FFF7FFF7F0000000000000000FF7FFF7FFF7FFF7F00000000
      0000000000000000FF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7F00000000
      0000000000000000FF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7F000000000000
      0000000000000000FF7FFF7FFF7F00000000FF7FFF7FFF7FFF7F000000000000
      00000000000000000000FF7FFF7FFF7FFF7FFF7FFF7FFF7F0000000000000000
      00000000000000000000FF7FFF7FFF7FFF7FFF7FFF7FFF7F0000000000000000
      000000000000000000000000FF7FFF7FFF7FFF7FFF7FFF7F0000000000000000
      000000000000000000000000FF7FFF7FFF7FFF7FFF7F00000000000000000000
      0000000000000000000000000000FF7FFF7FFF7FFF7F00000000000000000000
      0000000000000000000000000000FF7FFF7FFF7F000000000000000000000000
      00000000000000000000000000000000FF7F0000000000000000000000000000
      0000}
  
end
  object 
Memo1: TMemo
    Left = 12
    Top = 36
    Width = 149
    Height = 149
    Lines.Strings = ('Memo1')
    TabOrder = 0
    OnMouseDown = Memo1MouseDown
  end
  object 
Edit1: TEdit
    Left = 220
    Top = 60
    Width = 121
    Height = 21
    TabOrder = 1
    Text = 'Edit1'
    OnMouseDown = Edit1MouseDown
  end
end

 

printed from
www.swissdelphicenter.ch
developers knowledge base