ieditcustom.pas

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

    end;
end;
//****************************************************************************************************************************************************
procedure TiEditCustom.SetAlignment(const Value: TAlignment);
begin
  if FAlignment <> Value then
    begin
      FAlignment := Value;
      InvalidateChange;
    end;
end;
//****************************************************************************************************************************************************
procedure TiEditCustom.SetFont(const Value: TFont);
begin
  FFont.Assign(Value);
end;
//****************************************************************************************************************************************************
function TiEditCustom.GetBorderMargin: Integer;
begin
  if BorderStyle = ibsNone then Result := 0 else Result := 2;
end;
//****************************************************************************************************************************************************
function TiEditCustom.GetDisplayText(Value: String): String;
var
  x       : Integer;
  ALength : Integer;
begin
  Result := FText;
  if Length(FPasswordChar) <> 0 then
    begin
      ALength := Length(FText);
      Result   := '';
      for x := 0 to ALength-1 do
        Result := Result + Copy(FPasswordChar, 1, 1);
    end;
end;
//****************************************************************************************************************************************************
function TiEditCustom.GetTextToFit(Canvas: TCanvas; MaxWidth: Integer; DisplayText: String) : String;
begin
  with Canvas do
    begin
      FDrawLastCharIndex := Length(DisplayText)-1;
      Result := Copy(DisplayText, FDrawFirstCharIndex + 1, (FDrawLastCharIndex - FDrawFirstCharIndex + 1) );

      while TextWidth(Result) > FMaxWidth do
        begin
          Dec(FDrawLastCharIndex);
          Result := Copy(DisplayText, FDrawFirstCharIndex + 1, (FDrawLastCharIndex - FDrawFirstCharIndex + 1));
        end;

      while TextWidth(Result) > FMaxWidth do
        begin
          Inc(FDrawFirstCharIndex);
          Result := Copy(DisplayText, FDrawFirstCharIndex + 1, (FDrawLastCharIndex - FDrawFirstCharIndex + 1));
        end;
    end;
end;
//****************************************************************************************************************************************************
procedure TiEditCustom.iPaintTo(Canvas: TCanvas);
var
  AText        : String;
  ARect        : TRect;
  ATextWidth   : Integer;
  ATextFlags   : TiTextFlags;
  BorderMargin : Integer;
  ActualStart  : Integer;
  ActualStop   : Integer;
  DisplayText  : String;
begin
  with Canvas do
    begin
      if ErrorActive then
           DrawBackGround(Canvas, ErrorBackGroundColor)
      else DrawBackGround(Canvas, Self.Color);

      BorderMargin := GetBorderMargin;

      DisplayText := GetDisplayText(FText);
      
      if not ErrorActive then
        begin
          Font.Assign(FFont);

          FMaxWidth := Width - 2*BorderMargin - FAlignmentMargin;

          AText := DisplayText;


          if TextWidth(AText) < FMaxWidth then
            begin
              FDrawFirstCharIndex := 0;
              FDrawLastCharIndex  := Length(FText)-1;
            end
          else
            begin
              if FCursorPos < FDrawFirstCharIndex then FDrawFirstCharIndex := FCursorPos;

              AText := GetTextToFit(Canvas, MaxLength, DisplayText);

              while FCursorPos < FDrawFirstCharIndex do
                begin
                  Dec(FDrawFirstCharIndex);   
                  AText := GetTextToFit(Canvas, MaxLength, DisplayText);
                end;

              while FCursorPos > (FDrawLastCharIndex+1) do
                begin
                  Inc(FDrawFirstCharIndex);
                  AText := GetTextToFit(Canvas, MaxLength, DisplayText);
                end;
            end;
        end
      else
        begin
          Font.Assign(ErrorFont);
          AText := ErrorText;
        end;


      ATextWidth := TextWidth(AText);


      ARect.Top    :=           1+ BorderMargin;
      ARect.Bottom := ARect.Top + TextHeight(AText);

      ATextFlags := [itfHLeft, itfVTop, itfSingleLine, itfNoClip];

      case FAlignment of
        taCenter      : begin
                          ARect.Right := Width div 2 + ATextWidth div 2;
                          ARect.Left  := ARect.Right - ATextWidth;
                        end;
        taLeftJustify : begin
                          ARect.Left  := 2 + BorderMargin-1 + FAlignmentMargin;
                          ARect.Right := ARect.Left + ATextWidth;
                        end;
        else            begin
                          ARect.Right := Width - 2 - BorderMargin - FAlignmentMargin;
                          ARect.Left  := ARect.Right - ATextWidth;
                        end;
      end;

      Brush.Style := bsClear;
      iDrawText(Canvas, AText, ARect, ATextFlags);
      Brush.Style := bsSolid;

      FDrawRect := ARect;

      if not ErrorActive then
        begin
          AText := Copy(DisplayText, FDrawFirstCharIndex + 1, CursorPos - FDrawFirstCharIndex);
          {$ifdef iVCL}
          ATextWidth := TextWidth(AText);
          {$endif}
          if HasFocus then
            begin
              iCreateCaret;
              {$ifdef iVCL}
              ShowCaret(Handle);
              SetCaretPos(ARect.Left + ATextWidth, 3);
              {$endif}
            end;
        end
      else DeleteCaret;

      if (SelLength <> 0) and HasFocus and (not ErrorActive) then
        begin
          Brush.Style := bsSolid;
          Brush.Color := clHighlight;
          Font.Color  := clWhite;


          ActualStart := SelStart;
          ActualStop  := ActualStart + SelLength - 1;

          if ActualStart < FDrawFirstCharIndex then ActualStart := FDrawFirstCharIndex;
          if ActualStop  > FDrawLastCharIndex  then ActualStop  := FDrawLastCharIndex;

          AText := Copy(DisplayText, FDrawFirstCharIndex + 1,  ActualStart - FDrawFirstCharIndex);

          ARect.Left := FDrawRect.Left + TextWidth(AText);

          AText := Copy(DisplayText, ActualStart + 1,  ActualStop - ActualStart + 1);

          ARect.Right := ARect.Left + TextWidth(AText);

          FillRect(ARect);

          iDrawText(Canvas, AText, ARect, ATextFlags);
        end;
      DrawBorder(Canvas);
    end;
end;
//****************************************************************************************************************************************************
function TiEditCustom.PixelsToCharPos(Value: Integer): Integer;
var
  x     : Integer;
  AText : String;
  AChar : String;
  APos  : Integer;
begin
  Result := 0;
  with Canvas do
    begin
      Font.Assign(FFont);
      if Value < FDrawRect.Left then
        begin
          Result := FDrawFirstCharIndex-1;
          if Result < 0 then Result := 0;
        end
      else
        for x := FDrawFirstCharIndex to FDrawLastCharIndex+1 do
          begin
            AText := Copy(GetDisplayText(FText), FDrawFirstCharIndex + 1, x - FDrawFirstCharIndex + 1 - 1);
            AChar := Copy(GetDisplayText(FText), x , 1);
            APos := TextWidth(AText) + TextWidth(AChar) div 2;
            Result := x;
            if (FDrawRect.Left + APos) > Value then Break;
          end;
    end;
end;
//****************************************************************************************************************************************************
procedure TiEditCustom.iMouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  ScreenPoint : TPoint;
begin
  if not HasFocus then
    begin
      SetFocus;
      if FAutoSelect then SelectAll;
    end;

  if (Button = mbRight) and not Assigned(PopupMenu) then
    begin
      ScreenPoint := ClientToScreen(Point(X, Y));
      FPopupMenu.Popup(ScreenPoint.X, ScreenPoint.Y);
      Exit;
    end;

  CursorPos := PixelsToCharPos(X);

  FMouseDown        := True;

  if FDoubleClickActive then
    begin
      FDoubleClickActive := False;
    end
  else
    begin
      SelLength         := 0;
      SelStart          := CursorPos;
      FMouseDownCharPos := CursorPos;
    end;
end;
//****************************************************************************************************************************************************
procedure TiEditCustom.iMouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  FMouseDown := False;
end;
//****************************************************************************************************************************************************
procedure TiEditCustom.iMouseMove(Shift: TShiftState; X, Y: Integer);
begin
  Cursor  := crIBeam;

  if not FMouseDown then Exit;

  CursorPos := PixelsToCharPos(X);

  SelectCalc(FMouseDownCharPos, CursorPos);

  InvalidateChange;
end;
//****************************************************************************************************************************************************
{$ifdef iVCL}
procedure TiEditCustom.WMGetDLGCode(var Message: TMessage);
begin
  inherited;
  Message.Result := Message.Result or DLGC_WANTARROWS {+ DLGC_WANTALLKEYS};
end;
{$endif}
//****************************************************************************************************************************************************
procedure TiEditCustom.iDoSetFocus;
begin
  inherited;
  if ErrorActive then Exit;
  Canvas.Font.Assign(FFont);

  iCreateCaret;
  InvalidateChange;
end;
//****************************************************************************************************************************************************
procedure TiEditCustom.iDoKillFocus;
begin
  inherited;
  DeleteCaret;
  FMouseDown         := False;
  FDoubleClickActive := False;
  CompleteChange;
  InvalidateChange;
end;
//****************************************************************************************************************************************************
procedure TiEditCustom.SelectCalc(StartPos, CurrentPos: Integer);
begin
  if CurrentPos > StartPos then
    begin
      SelStart := StartPos;
      SelLength := CurrentPos - StartPos;
    end
  else
    begin
      SelStart := CurrentPos;
      SelLength := StartPos - CurrentPos;
    end;
end;
//****************************************************************************************************************************************************
procedure TiEditCustom.iKeyPress(var Key: Char);
begin
  inherited iKeyPress(Key);
  
  if Key = #0 then Exit;

  case ord(Key) of
    iVK_BACK    : begin