ieditcustom.pas

iocopm3.04源码,一套很好的工控开发工具

{*******************************************************}
{                                                       }
{       TiEditCustom Component                          }
{                                                       }
{       Copyright (c) 1997,2003 Iocomp Software         }
{                                                       }
{*******************************************************}
{$I iInclude.inc}

{$ifdef iVCL}unit  iEditCustom;{$endif}
{$ifdef iCLX}unit QiEditCustom;{$endif}

interface

uses
  {$I iIncludeUses.inc}
  {$IFDEF iVCL} Menus,  iTypes,  iGPFunctions,  iCustomComponent;{$ENDIF}
  {$IFDEF iCLX}QMenus, QiTypes, QiGPFunctions, QiCustomComponent;{$ENDIF}

type
  TiEditCustom = class(TiCustomComponent)
  private
    FText               : String;
    FFont               : TFont;
    FDoingAutoSize      : Boolean;

    FPopupMenu          : TPopupMenu;
    FApplyMenuItem      : TMenuItem;
    FUndoMenuItem       : TMenuItem;
    FDivider1MenuItem   : TMenuItem;
    FCutMenuItem        : TMenuItem;
    FCopyMenuItem       : TMenuItem;                            
    FPasteMenuItem      : TMenuItem;
    FDeleteMenuItem     : TMenuItem;
    FDivider2MenuItem   : TMenuItem;
    FSelectAllMenuItem  : TMenuItem;

    FUndoText           : String;

    FMouseDown          : Boolean;
    FMouseDownCharPos   : Integer;
    FMaxWidth           : Integer;
    FAlignment          : TAlignment;
    FAlignmentMargin    : Integer;
    FSelStart           : Integer;
    FSelLength          : Integer;
    FCursorPos          : Integer;
    FCaretCreated       : Boolean;
    FDrawRect           : TRect;
    FDrawFirstCharIndex : Integer;
    FDrawLastCharIndex  : Integer;
    FDoubleClickActive  : Boolean;
    FAutoSelect         : Boolean;
    FAutoSize           : Boolean;
    FOnChange           : TNotifyEvent;
    FOnAutoSize         : TNotifyEvent;
    FMaxLength          : Integer;
    FColor              : TColor;
    FPasswordChar       : String;
  protected
    procedure SetFont           (const Value: TFont);
    procedure SetText           (const Value: String); reintroduce;
    procedure SetAlignment      (const Value: TAlignment);
    procedure SetAlignmentMargin(const Value: Integer);
    procedure SetSelLength      (const Value: Integer);
    procedure SetSelStart       (const Value: Integer);
    procedure SetCursorPos      (const Value: Integer);
    procedure SetMaxLength      (const Value: Integer); virtual;
    procedure SetAutoSelect     (const Value: Boolean);
    procedure SetPasswordChar   (const Value: String);
    procedure iSetAutoSize      (const Value: Boolean);
    procedure SetColor          (const Value: TColor);

    function GetCanUndo  : Boolean;
    function GetModified : Boolean;

    procedure DeleteCaret;
    procedure iCreateCaret;

    procedure PopupMenuOpen         (Sender: TObject);

    procedure ApplyMenuItemClick    (Sender: TObject);
    procedure UndoMenuItemClick     (Sender: TObject);
    procedure CutMenuItemClick      (Sender: TObject);
    procedure CopyMenuItemClick     (Sender: TObject);
    procedure PasteMenuItemClick    (Sender: TObject);
    procedure DeleteMenuItemClick   (Sender: TObject);
    procedure SelectAllMenuItemClick(Sender: TObject);

    procedure iMouseDown (Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure iMouseUp   (Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure iMouseMove (                      Shift: TShiftState; X, Y: Integer); override;

    procedure iDoubleClick;                                                         override;

    procedure iDoSetFocus;                                                          override;
    procedure iDoKillFocus;                                                         override;

    procedure iPaintTo(Canvas: TCanvas);                                            override;

    procedure iKeyPress   (var Key: Char);                                          override;
    procedure iKeyDown   (var CharCode: Word; Shift: TShiftState);                  override;

    {$ifdef iVCL}
    procedure WMGetDLGCode(var Message: TMessage); message WM_GETDLGCODE;
    {$endif}

    procedure FontChange(Sender : TObject);

    procedure DoChange; virtual;
    procedure DoAutoSize;

    procedure CompleteChange; virtual;

    function AllowKey    (Key: Char    ): Boolean; virtual;

    procedure SelectCalc(StartPos, CurrentPos: Integer);

    function  GetCursorInView: Boolean;

    procedure InsertText(Value: String);

    procedure CursorHome  (Shift: TShiftState);
    procedure CursorEnd   (Shift: TShiftState);
    procedure CursorLeft  (Shift: TShiftState);
    procedure CursorRight (Shift: TShiftState);

    function GetSelText: String;
    procedure SetSelText(const Value: String);

    function GetDisplayText(Value: String): String;
    function GetTextToFit(Canvas: TCanvas; MaxWidth: Integer; DisplayText: String) : String;

    function GetBorderMargin: Integer;
    function PixelsToCharPos(Value: Integer): Integer;

    property CursorPos     : Integer       read FCursorPos    write SetCursorPos;

    property OnAutoSize    : TNotifyEvent  read FOnAutoSize   write FOnAutoSize;

    property Text          : String        read FText         write SetText;
    property UndoText      : String        read FUndoText     write FUndoText;
    property PasswordChar  : String        read FPasswordChar write SetPasswordChar;
  public
    constructor Create(AOwner: TComponent);  override;
    destructor  Destroy;                     override;

    procedure SelectAll; virtual;
    procedure ClearSelection;

    procedure Apply;
    procedure Undo;
    procedure ClearUndo;
    procedure CopyToClipBoard;
    procedure CutToClipBoard;
    procedure PasteFromClipBoard;

    procedure Clear;

    property SelText   : String             read GetSelText       write SetSelText;
    property SelStart  : Integer            read FSelStart        write SetSelStart;
    property SelLength : Integer            read FSelLength       write SetSelLength;
    property CanUndo   : Boolean            read GetCanUndo;
    property Modified  : Boolean            read GetModified;
  published
    property Alignment       : TAlignment   read FAlignment       write SetAlignment       default taLeftJustify;
    property AlignmentMargin : Integer      read FAlignmentMargin write SetAlignmentMargin default 0;
    property AutoSelect      : Boolean      read FAutoSelect      write SetAutoSelect      default True;
    property AutoSize        : Boolean      read FAutoSize        write iSetAutoSize       default True;
    property MaxLength       : Integer      read FMaxLength       write SetMaxLength;
    property Font            : TFont        read FFont            write SetFont;
    property BorderStyle                                                                   default ibsLowered;
    property TabOrder;
    property TabStop                                                                       default True;
    property Color           : TColor       read FColor           write SetColor           default clWindow;

    property OnChange        : TNotifyEvent read FOnChange        write FOnChange;

    property Width        default 80;
    property Height       default 21;
  end;

implementation
//****************************************************************************************************************************************************
constructor TiEditCustom.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  Width   := 80;
  Height  := 21;
  TabStop := True;
  FColor  := clWindow;

  BorderStyle        := ibsLowered;

  FAlignment         := taLeftJustify;
  FAutoSelect        := True;
  FAutoSize          := True;

  FFont              := TFont.Create;
  Font.OnChange      := FontChange;

  FPopupMenu         := TPopupMenu.Create(Self);
  FPopupMenu.OnPopup := PopupMenuOpen;

  FApplyMenuItem     := TMenuItem.Create(PopupMenu); FApplyMenuItem.Caption     := 'Apply';      FApplyMenuItem.OnClick     := ApplyMenuItemClick;
  FUndoMenuItem      := TMenuItem.Create(PopupMenu); FUndoMenuItem.Caption      := 'Undo';       FUndoMenuItem.OnClick      := UndoMenuItemClick;
  FDivider1MenuItem  := TMenuItem.Create(PopupMenu); FDivider1MenuItem.Caption  := '-';
  FCutMenuItem       := TMenuItem.Create(PopupMenu); FCutMenuItem.Caption       := 'Cut';        FCutMenuItem.OnClick       := CutMenuItemClick;
  FCopyMenuItem      := TMenuItem.Create(PopupMenu); FCopyMenuItem.Caption      := 'Copy';       FCopyMenuItem.OnClick      := CopyMenuItemClick;
  FPasteMenuItem     := TMenuItem.Create(PopupMenu); FPasteMenuItem.Caption     := 'Paste';      FPasteMenuItem.OnClick     := PasteMenuItemClick;
  FDeleteMenuItem    := TMenuItem.Create(PopupMenu); FDeleteMenuItem.Caption    := 'Delete';     FDeleteMenuItem.OnClick    := DeleteMenuItemClick;
  FDivider2MenuItem  := TMenuItem.Create(PopupMenu); FDivider2MenuItem.Caption  := '-';
  FSelectAllMenuItem := TMenuItem.Create(PopupMenu); FSelectAllMenuItem.Caption := 'Select All'; FSelectAllMenuItem.OnClick := SelectAllMenuItemClick;

  FPopupMenu.Items.Add(FApplyMenuItem);
  FPopupMenu.Items.Add(FUndoMenuItem);
  FPopupMenu.Items.Add(FDivider1MenuItem);
  FPopupMenu.Items.Add(FCutMenuItem);
  FPopupMenu.Items.Add(FCopyMenuItem);
  FPopupMenu.Items.Add(FPasteMenuItem);
  FPopupMenu.Items.Add(FDeleteMenuItem);
  FPopupMenu.Items.Add(FDivider2MenuItem);
  FPopupMenu.Items.Add(FSelectAllMenuItem);
end;
//****************************************************************************************************************************************************
destructor TiEditCustom.Destroy;
begin
  FFont.Free;
  inherited;
end;
//****************************************************************************************************************************************************
procedure TiEditCustom.DoChange;
begin
  if not (csLoading in ComponentState) then
    begin
      if Assigned(OnChangeProtected) then OnChangeProtected(Self, 'Value');
      if Assigned(FOnChange)         then FOnChange(Self);
    end;
end;
//****************************************************************************************************************************************************
procedure TiEditCustom.FontChange(Sender : TObject);
begin
  DoAutoSize;
  InvalidateChange;
end;
//****************************************************************************************************************************************************
procedure TiEditCustom.SetAlignmentMargin(const Value: Integer);begin SetIntegerProperty(Value, FAlignmentMargin, irtInvalidate);end;
procedure TiEditCustom.SetAutoSelect     (const Value: Boolean);begin SetBooleanProperty(Value, FAutoSelect,      irtNone      );end;
procedure TiEditCustom.SetMaxLength      (const Value: Integer);begin SetIntegerProperty(Value, FMaxLength,       irtNone      );end;
procedure TiEditCustom.SetColor          (const Value: TColor );begin SetColorProperty  (Value, FColor,           irtInvalidate);end;
procedure TiEditCustom.SetPasswordChar   (const Value: String );begin SetStringProperty (Value, FPasswordChar,    irtInvalidate);end;
//****************************************************************************************************************************************************
procedure TiEditCustom.SetText(const Value: String);
begin
  if FText <> Value then
    begin
      FText := Value;
      SelLength := 0;
      CursorPos := 0;
      CompleteChange;
      InvalidateChange;
    end;
end;
//****************************************************************************************************************************************************
procedure TiEditCustom.SetSelLength(const Value: Integer);
var
  TempValue : Integer;
begin
  TempValue := Value;
  if TempValue < 0 then             TempValue := 0;
  if TempValue > Length(FText) then TempValue := Length(FText);

  if FSelLength <> TempValue then
    begin
      FSelLength := Value;
      InvalidateChange;
    end;
end;
//****************************************************************************************************************************************************
procedure TiEditCustom.SetSelStart(const Value: Integer);
var
  TempValue : Integer;
begin
  TempValue := Value;
  if TempValue < 0 then             TempValue := 0;
  if TempValue > Length(FText) then TempValue := Length(FText);

  if FSelStart <> TempValue then
    begin
      FSelStart := Value;
      InvalidateChange;
    end;
end;
//****************************************************************************************************************************************************
function TiEditCustom.GetCursorInView: Boolean;
var
  AText : String;
begin
  Result := True;
  if FCursorPos < FDrawFirstCharIndex then
    begin
      Result := False;
      Exit;
    end;

  Canvas.Font.Assign(FFont);
  AText := GetDisplayText(Copy(FText, FDrawFirstCharIndex + 1, FCursorPos - FDrawFirstCharIndex + 1));
  if Canvas.TextWidth(AText) > FMaxWidth then Result := False;
end;
//****************************************************************************************************************************************************
procedure TiEditCustom.SetCursorPos(const Value: Integer);
var
  TempValue : Integer;
begin
  TempValue := Value;
  if TempValue < 0 then             TempValue := 0;
  if TempValue > Length(FText) then TempValue := Length(FText);

  if FCursorPos <> TempValue then
    begin
      FCursorPos := TempValue;
      InvalidateChange;