cdibedit.pas

Delphi控件

    if XPos >= RightBorder then Break;
    //Minor Changed by Riceball.
    Inc(I, Length(C));
  end;
  //Added by Riceball.
  if CursorPos > 0 then
    CursorXPos := CursorXPos + GetTextWidth(Copy(FText, FFirstDisplayChar,
      CursorPos - FFirstDisplayChar));

  if Focused and FCursorShowing then
    if (Text = '') or (CursorPos = 0) then
      DrawCursor(CursorXPos, #0)
    else if PasswordChar = #0 then
      DrawCursor(CursorXPos, Text[CursorPos])
    else
      DrawCursor(CursorXPos, PasswordChar);
  DrawBorder;

  if Assigned(OnPaint) then OnPaint(Self);
end;

procedure TAbstractDIBEdit.KeyDown(var Key: Word; Shift: TShiftState);
var
  OrigCursorPos: Integer;
begin
  inherited;
  case Key of
    VK_Home: CursorPos := 0;
    VK_Left:
      begin
        repeat
          OrigCursorPos := CursorPos;
          {$IFDEF MBCSSUPPORT}
          if ByteType(FText, CursorPos) = mbTrailByte then
            CursorPos := CursorPos - 2
          else
            CursorPos := CursorPos - 1;
          {$ELSE}
          CursorPos := CursorPos - 1;
          {$ENDIF}
        until (CursorPos = OrigCursorPos) or not (ssCTRL in Shift) or
          (Copy(FText, CursorPos, 1) = ' ');
      end;

    VK_Right:
      begin
        repeat
          OrigCursorPos := CursorPos;
          {$IFDEF MBCSSUPPORT}
          if ByteType(FText, CursorPos + 1) = mbLeadByte then
            CursorPos := CursorPos + 2
          else
            CursorPos := CursorPos + 1;
          {$ELSE}
          CursorPos := CursorPos + 1;
          {$ENDIF}
        until (CursorPos = OrigCursorPos) or not (ssCTRL in Shift) or
          (Copy(FText, CursorPos, 1) = ' ');
      end;

    VK_End: CursorPos := Length(Text);

    VK_Back:
      if not ReadOnly then
      begin
        if SelLength > 0 then
          SelText := ''
        else
        begin
          {$IFDEF MBCSSUPPORT}
          if ByteType(FText, CursorPos) = mbTrailByte then
          begin
            Delete(FText, CursorPos - 1, 2);
            CursorPos := CursorPos - 2;
          end
          else
          begin
            Delete(FText, CursorPos, 1);
            CursorPos := CursorPos - 1;
          end;
          {$ELSE}
          Delete(FText, CursorPos, 1);
          CursorPos := CursorPos - 1;
          {$ENDIF}
          Change;
        end;
      end;

    VK_Delete:
      if not ReadOnly then
      begin
        if ssCTRL in Shift then
          CutToClipboard
        else
        if SelLength > 0 then
          SelText := ''
        else
        if CursorPos < Length(Text) then
        begin
          {$IFDEF MBCSSUPPORT}
          if ByteType(FText, CursorPos + 1) = mbLeadByte then
            Delete(FText, CursorPos + 1, 2)
          else
            Delete(FText, CursorPos + 1, 1);
          {$ELSE}
          Delete(FText, CursorPos + 1, 1);
          {$ENDIF}
          Change;
        end;
      end;

    VK_Insert: if ssCTRL in Shift then PasteFromClipboard;

    Ord('x'), Ord('X'): if ssCTRL in Shift then CutToClipboard;
    Ord('c'), Ord('C'): if ssCTRL in Shift then CopyToClipboard;
    Ord('v'), Ord('V'): if ssCTRL in Shift then PasteFromClipboard;
  end;
end;

procedure TAbstractDIBEdit.KeyPress(var Key: Char);
begin
  if ReadOnly then Exit;
  if Key < #32 then Exit;
  if (MaxLength > 0) and (Length(Text) = MaxLength) then Exit;
  case CharCase of
    ecNormal: SelText := Key;
    ecUpperCase: SelText := Upcase(Key);
    ecLowerCase: SelText := LowerCase(Key)[1];
  end;
  Change;
end;

procedure TAbstractDIBEdit.KeyUp(var Key: Word; Shift: TShiftState);
begin
  inherited;
end;

procedure TAbstractDIBEdit.DoEnter;
begin
  inherited;
  FCursorShowing := True;
  FCursorTimer.Enabled := True;
  SelStart := 0;
  if AutoSelect then
    SelLength := Length(Text)
  else
    SelLength := 0;
  Invalidate;
end;

procedure TAbstractDIBEdit.DoExit;
begin
  inherited;
  FCursorTimer.Enabled := False;
  SelStart := 0;
  SelLength := 0;
  Invalidate;
end;

procedure TAbstractDIBEdit.CalcFirstDisplayChar;
var
  Value: string;
begin
  if PasswordChar = #0 then
    Value := Text
  else
    Value := StringOfChar(PasswordChar, Length(Text));
  if CursorPos < FFirstDisplayChar then FFirstDisplayChar := CursorPos - 5;
  while GetTextWidth(Copy(Value, FFirstDisplayChar, FCursorPos - FFirstDisplayChar + 1)) >=
    (Width - GetLeftBorderSize - GetRightBorderSize) do
    Inc(FFirstDisplayChar, 5);
  if FFirstDisplayChar > Length(Value) then FFirstDisplayChar := Length(Value) - 5;
  if FFirstDisplayChar <= 0 then FFirstDisplayChar := 1;
end;

procedure TAbstractDIBEdit.SetCursorPos(Value: Integer);
var
  OldCursorPos, Distance: Integer;
begin
  if Value < 0 then Value := 0;
  if Value > Length(Text) then Value := Length(Text);
  FCursorTimer.Enabled := False;
  FCursorShowing := True;
  FCursorTimer.Enabled := True;

  OldCursorPos := CursorPos;
  FCursorPos := Value;

  if not (ssShift in ShiftState) and not (mbLeft in MouseButtons) then
  begin
    FSelPoint1 := CursorPos;
    FSelPoint2 := CursorPos;
    SelStart := CursorPos;
  end 
  else
  begin
    Distance := Value - OldCursorPos;
    if OldCursorPos = FSelPoint2 then
      Inc(FSelPoint2, Distance)
    else
      Inc(FSelPoint1, Distance);
  end;

  CalcFirstDisplayChar;
  Invalidate;
end;

procedure TAbstractDIBEdit.CMFontChanged(var Message: TMessage);
begin
  if AutoSize then AdjustSize;
  Change;
end;

procedure TAbstractDIBEdit.DoBlink(Sender: TObject);
begin
  FCursorShowing := not FCursorShowing;
  Invalidate;
end;

procedure TAbstractDIBEdit.MouseDown(Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  inherited;
  if Button = mbLeft then
  begin
    {$ifdef MBCSSUPPORT}
    X := HitTest(X, Y).X;
    if ByteType(FText, X + 1) = mbTrailByte then
      CursorPos := X + 1
    else
      CursorPos := X;
    {$else}
    CursorPos := HitTest(X, Y).X;
    {$endif}
    SelStart := CursorPos;
    SelLength := 0;
  end;
end;

procedure TAbstractDIBEdit.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  inherited;
  if mbLeft in MouseButtons then
  {$ifdef MBCSSUPPORT}
  begin
    X := HitTest(X, Y).X;
    if ByteType(FText, X + 1) = mbTrailByte then
      CursorPos := X + 1
    else 
      CursorPos := X;
  end;
  {$else}
  CursorPos := HitTest(X, Y).X;
  {$endif}
end;

procedure TAbstractDIBEdit.MouseUp(Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  inherited;
end;

function TAbstractDIBEdit.HitTest(XPos, YPos: Integer): TPoint;
var
  I, CurrentX, RightBorderEdge, CharWidth: Integer;
begin
  Result.X := -1;
  Result.Y := 0;
  if Length(Text) = 0 then Exit;

  CurrentX := GetLeftBorderSize;
  RightBorderEdge := Width - GetRightBorderSize;
  for I := FirstDisplayChar - 1 to Length(Text) do
  begin
    if PasswordChar <> #0 then
      CharWidth := GetTextWidth('*')
    else
      CharWidth := GetTextWidth(Text[I]);
    if CurrentX + CharWidth + (CharWidth shr 1) >= XPos then
    begin
      Result.X := I;
      Break;
    end;

    Inc(CurrentX, CharWidth);
    if CurrentX >= (RightBorderEdge) then Break;
  end;
  if Result.X < 0 then Result.X := Length(Text);
end;

procedure TAbstractDIBEdit.SetDIBBorder(const Value: TDIBBorder);
begin
  inherited;
  if AutoSize then AdjustSize;
end;

procedure TAbstractDIBEdit.DoDefaultPopupMenu(const PopupMenu: TPopupMenu);
  function AddMenu(const Caption: string; Enabled: Boolean): TMenuItem;
  begin
    Result := TMenuItem.Create(Self);
    Result.Caption := Caption;
    Result.Enabled := Enabled;
    Result.OnClick := MenuEvent;
    PopupMenu.Items.Add(Result);
  end;

begin
  inherited;
  with AddMenu('Undo', CanUndo) do Tag := cMenuUndo;
  AddMenu('-', False);
  with AddMenu('Cut', not ReadOnly) do Tag := cMenuCut;
  with AddMenu('Copy', SelLength > 0) do Tag := cMenuCopy;
  with AddMenu('Paste', (not ReadOnly) and (Clipboard.AsText <> '')) do Tag := cMenuPaste;
  with AddMenu('Delete', (not ReadOnly) and (SelLength > 0)) do Tag := cMenuDelete;
  AddMenu('-', False);
  with AddMenu('Select All', Length(FText) > 0) do Tag := cMenuSelectAll;
end;

procedure TAbstractDIBEdit.MenuEvent(Sender: TObject);
begin
  case (Sender as TMenuItem).Tag of
    cMenuUndo: Undo;
    cMenuCut: CutToClipboard;
    cMenuCopy: CopyToClipboard;
    cMenuPaste: PasteFromClipboard;
    cMenuDelete: ClearSelection;
    cMenuSelectAll:
      begin
        SelStart := 0;
        SelLength := Length(FText);
      end;
  end;
end;

function TAbstractDIBEdit.CanAutoSize(var NewWidth,
  NewHeight: Integer): Boolean;
begin
  NewHeight := GetTopBorderSize + GetTopBorderSize + GetTextHeight;
  Result := NewHeight > 0;
end;

{ TCustomDIBEdit }
                                        
procedure TCustomDIBEdit.DrawBorder;
var
  Handled: Boolean;
begin
  if Assigned(DIBBorder) then
  begin
    inherited;
    Exit;
  end;

  if BorderStyle = bsSingle then
  begin
    Handled := False;
    if Assigned(OnDrawBorder) then OnDrawBorder(Self, Handled);
    if not Handled then with Canvas do
      begin
        Pen.Style := psSolid;
        Pen.Color := clBtnShadow;
        Pen.Width := 4;

        MoveTo(0, Height);
        LineTo(0, 0);
        LineTo(Width, 0);

        Pen.Width := 1;
        Pen.Color := clBtnHighlight;
        MoveTo(0, Height - 1);
        LineTo(Width - 1, Height - 1);
        LineTo(Width - 1, 0);

        Pen.Color := clBtnFace;
        MoveTo(2, Height - 2);
        LineTo(Width - 2, Height - 2);
        LineTo(Width - 2, 1);
      end;
  end;
end;

procedure TCustomDIBEdit.DrawCursor(XPos: Integer; CurrentChar: Char);
var
  Handled: Boolean;
  CharWidth, LineHeight: Integer;
begin
  Handled := False;
  if Assigned(OnDrawCursor) then OnDrawCursor(Self, XPos, CurrentChar, Handled);
  if not Handled then with Canvas do
    begin
      Font.Assign(Self.Font);
      if CurrentChar <> #0 then
        CharWidth := TextWidth(CurrentChar) + 1
      else
        CharWidth := 0;
      Pen.Color := Self.Font.Color;
      Pen.Style := psSolid;
      Pen.Width := 2;

      LineHeight := GetTextHeight;
      if LineHeight > Height - GetBottomBorderSize - 1 then
        LineHeight := Height - GetBottomBorderSize - 1;
      MoveTo(XPos + CharWidth, GetTopBorderSize);
      LineTo(XPos + CharWidth, GetTopBorderSize + LineHeight);
    end;
end;

procedure TCustomDIBEdit.DrawText(XPos, YPos: Integer; Value: string; Selected: Boolean);
var
  Handled: Boolean;
begin
  Handled := False;
  if Assigned(OnDrawText) then OnDrawText(Self, XPos, YPos, Value, Selected, Handled);

  if not Handled then with Canvas do
    begin
      Font.Assign(Self.Font);
      if Selected then
      begin
        Canvas.Brush.Style := Graphics.bsSolid;
        Canvas.Brush.Color := clHighlight;
        Font.Color := clHighlightText;
      end 
      else
        Canvas.Brush.Style := bsClear;
      TextOut(XPos, YPos, Value);
    end;
end;

function TCustomDIBEdit.GetBottomBorderSize: Integer;
begin
  if Assigned(DIBBorder) then
  begin
    Result := inherited GetBottomBorderSize;
    Exit;
  end;

  if BorderStyle <> bsSingle then
    Result := 0
  else
  begin
    Result := 3;
    if Assigned(OnMeasureBottomBorder) then OnMeasureBottomBorder(Self, Result);
  end;
end;

function TCustomDIBEdit.GetLeftBorderSize: Integer;
begin
  if Assigned(DIBBorder) then
  begin
    Result := inherited GetLeftBorderSize;
    Exit;
  end;

  if BorderStyle <> bsSingle then
    Result := 0
  else
  begin
    Result := 3;
    if Assigned(OnMeasureLeftBorder) then OnMeasureLeftBorder(Self, Result);
  end;
end;

function TCustomDIBEdit.GetRightBorderSize: Integer;
begin
  if Assigned(DIBBorder) then
  begin
    Result := inherited GetRightBorderSize;
    Exit;
  end;

  if BorderStyle <> bsSingle then
    Result := 0
  else
  begin
    Result := 3;
    if Assigned(OnMeasureRightBorder) then OnMeasureRightBorder(Self, Result);
  end;
end;

function TCustomDIBEdit.GetTopBorderSize: Integer;
begin
  if Assigned(DIBBorder) then
  begin
    Result := inherited GetTopBorderSize;
    Exit;
  end;

  if BorderStyle <> bsSingle then
    Result := 0
  else
  begin
    Result := 3;
    if Assigned(OnMeasureTopBorder) then OnMeasureTopBorder(Self, Result);
  end;
end;

function TCustomDIBEdit.GetTextHeight: Integer;
var
  TxtWidth: Integer;
begin
  Result := 0;
  if Parent = nil then Exit;
  with TControlCanvas.Create do
    try
      Control := Parent;
      Font.Assign(Self.Font);
      Result := TextHeight('Wg');
      if Assigned(OnMeasureText) then
      begin
        TxtWidth := TextWidth('G');
        OnMeasureText(Self, TxtWidth, Result);
      end;
    finally
      Free;
    end;
end;

function TCustomDIBEdit.GetTextWidth(Value: string): Integer;
var
  TxtHeight: Integer;
begin
  Result := 0;
  if Parent = nil then Exit;
  with TControlCanvas.Create do
    try
      Control := Parent;
      Font.Assign(Self.Font);
      Result := TextWidth(Value);
      if Assigned(OnMeasureText) then
      begin
        //Minor Changed by Riceball.
        TxtHeight := TextHeight('Wg');
        OnMeasureText(Self, Result, TxtHeight);
      end;
    finally
      Free;
    end;
end;

procedure TCustomDIBEdit.Loaded;
begin
  inherited;
  CursorPos := 0;
end;

end.