ilinkedlistbox.pas

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

      AFlags := [itfVCenter, itfHLeft, itfSingleLine];

      for x := FStartIndex to FStopIndex do
        begin
          Font.Assign(FFont);
          Brush.Style := bsClear;

          AText := '';
          if Assigned(FOnGetItemString) then FOnGetItemString(Self, x, AText);

          State := [];
          if HasFocus and (x = FItemIndex)                            then Include(State, odFocused);
          if (x = 0)  and (FItemIndex = -1) and FShowFocusNoSelection then Include(State, odFocused);
          if x = ItemIndex                                            then Include(State, odSelected);


          if Assigned(FOnPaintItem) then FOnPaintItem(Self, Canvas, FocusRect, State, x, AText, Handled);

          if not Handled then
            begin
              if odSelected in State then
                begin
                  Brush.Style := bsSolid;
                  Brush.Color := FSelectedColor;
                  Pen.Style   := psSolid;
                  Pen.Color   := FSelectedColor;
                  Rectangle(0, ARect.Top, ARect.Right, ARect.Bottom);
                  Font.Color := FSelectedFontColor;
                end
              else
                begin

                end;

              iDrawText(Canvas, AText, ARect, AFlags);

              if odFocused in State then
                begin
                  iDrawFocusRect(Canvas, FocusRect, clNavy);
                end;
          end;

          OffsetRect(ARect,     0, FItemHeight);
          OffsetRect(FocusRect, 0, FItemHeight);
        end;

      DrawBorder(Canvas);

      FItemsRect := Rect(FBorderMargin, FBorderMargin, Width - FBorderMargin, Height - FBorderMargin);
      if FScrollBarVisible then FItemsRect.Right := FScrollBarRect.Left;
    end;
end;
//****************************************************************************************************************************************************
procedure TiLinkedListBox.DrawScrollBar(Canvas: TCanvas);
var
  ButtonSize       : Integer;
  BarPixelRange    : Integer;
  BarPercentHeight : Double;
  BarButtonHeight  : Integer;
  BarStartPercent  : Double;
begin
  with Canvas do
    begin
      ButtonSize   := 16;

      Brush.Color := $F0F0F0;
      Brush.Style := bsSolid;
      Pen.Color   := Brush.Color;
      Pen.Style   := psSolid;
      FScrollBarRect := Rect(Width - FBorderMargin - ButtonSize, FBorderMargin, Width - FBorderMargin, Height - FBorderMargin);
      Rectangle(FScrollBarRect.Left, FScrollBarRect.Top, FScrollBarRect.Right, FScrollBarRect.Bottom);

      Brush.Color := clBtnFace;
      Pen.Color   := clBtnFace;

      FButtonUpRect   := Rect(FScrollBarRect.Left, FScrollBarRect.Top,                 FScrollBarRect.Right, FScrollBarRect.Top + ButtonSize);
      FButtonDownRect := Rect(FScrollBarRect.Left, FScrollBarRect.Bottom - ButtonSize, FScrollBarRect.Right, FScrollBarRect.Bottom);

      FillRect(FButtonUpRect);
      FillRect(FButtonDownRect);

      if FButtonUpMouseDown   then iDrawEdge(Canvas, FButtonUpRect,   idesFlat) else iDrawEdge(Canvas, FButtonUpRect,   idesRaised);
      if FButtonDownMouseDown then iDrawEdge(Canvas, FButtonDownRect, idesFlat) else iDrawEdge(Canvas, FButtonDownRect, idesRaised);

      iDrawButtonArrowUp  (Canvas, FButtonUpRect,   FButtonUpMouseDown);
      iDrawButtonArrowDown(Canvas, FButtonDownRect, FButtonDownMouseDown);

      //---------------------------------------------------------------------------------------------------------------------------
      FBarRect       := Rect(FScrollBarRect.Left, FScrollBarRect.Top + ButtonSize, FScrollBarRect.Right, FScrollBarRect.Bottom - ButtonSize);
      FBarButtonRect := FBarRect;
      Brush.Color    := clBtnFace;

      BarPixelRange    := FBarRect.Bottom - FBarRect.Top;
      BarPercentHeight := FMaxCountVisible/FItemCount;
      BarButtonHeight  := Round(BarPixelRange * BarPercentHeight);

      if FBarButtonMouseDown then
        begin
          FBarButtonRect.Top := FBarButtonMouseDownTop + FMouseMoveY - FMouseDownY;
          if FBarButtonRect.Top                     < FBarRect.Top    then FBarButtonRect.Top := FBarRect.Top;
          if (FBarButtonRect.Top + BarButtonHeight) > FBarRect.Bottom then FBarButtonRect.Top := FBarRect.Bottom - BarButtonHeight;

          FStartIndex := Round((FBarButtonRect.Top - FBarRect.Top)/BarPixelRange * FItemCount);
        end
      else
        begin
          BarStartPercent    := FStartIndex/FItemCount;
          FBarButtonRect.Top := FBarButtonRect.Top + Round(BarStartPercent * BarPixelRange);
        end;

      FBarButtonRect.Bottom := FBarButtonRect.Top + BarButtonHeight;

      FillRect(FBarButtonRect);
      iDrawEdge(Canvas, FBarButtonRect, idesRaised);
    end;
end;
//****************************************************************************************************************************************************
procedure TiLinkedListBox.iMouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  iSetFocus(Self);

  FButtonUpMouseDown   := False;
  FButtonDownMouseDown := False;
  FBarButtonMouseDown  := False;
  FItemsMouseDown      := False;

  if FScrollBarVisible then
    begin
      if      PtInRect(FButtonUpRect,   Point(X, Y)) then begin FButtonUpMouseDown   := True; DoButtonUpClick;   end
      else if PtInRect(FButtonDownRect, Point(X, Y)) then begin FButtonDownMouseDown := True; DoButtonDownClick; end
      else if PtInRect(FBarRect, Point(X, Y)) then
        begin
          if      Y < FBarButtonRect.Top    then DoPageUpClick
          else if Y > FBarButtonRect.Bottom then DoPageDownClick
          else
            begin
              FBarButtonMouseDown    := True;
              FMouseDownY            := Y;
              FBarButtonMouseDownTop := FBarButtonRect.Top;
            end;
        end;
    end;

  if PtInRect(FItemsRect, Point(X, Y)) then FItemsMouseDown := True;

  if FButtonUpMouseDown or FButtonDownMouseDown then
    begin
      FTimer.Interval    := FRepeatInitialDelay;
      FTimer.Enabled     := True;
      FFirstTimerMessage := True;
    end
  else if FBarButtonMouseDown then
    begin


    end
  else if PtInRect(FItemsRect, Point(X, Y)) then
    begin
      ItemIndex := FStartIndex + (Y - FItemsRect.Top) div FItemHeight;
    end;

  InvalidateChange;
end;
//****************************************************************************************************************************************************
procedure TiLinkedListBox.iMouseMove(Shift: TShiftState; X, Y: Integer);
begin
  FMouseMoveY := Y;
  if FItemsMouseDown then
    begin
      ItemIndex := FStartIndex + (Y - FItemsRect.Top) div FItemHeight;
    end
  else if FBarButtonMouseDown then InvalidateChange;
end;
//****************************************************************************************************************************************************
procedure TiLinkedListBox.iMouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  FButtonUpMouseDown   := False;
  FButtonDownMouseDown := False;
  FBarButtonMouseDown  := False;
  FItemsMouseDown      := False;

  FTimer.Enabled := False;
  InvalidateChange;
end;
//****************************************************************************************************************************************************
procedure TiLinkedListBox.iDoSetFocus;
begin
  inherited iDoSetFocus;
end;
//****************************************************************************************************************************************************
procedure TiLinkedListBox.iDoKillFocus;
begin
  inherited iDoKillFocus;
  FButtonUpMouseDown   := False;
  FButtonDownMouseDown := False;
  FBarButtonMouseDown  := False;
  FItemsMouseDown      := False;

  FTimer.Enabled       := False;
end;
//****************************************************************************************************************************************************
procedure TiLinkedListBox.iKeyDown(var CharCode: Word; Shift: TShiftState);
begin
  case CharCode of
    VK_LEFT,
    VK_UP     : ItemIndex := ItemIndex-1;
    VK_RIGHT,
    VK_DOWN   : ItemIndex := ItemIndex+1;
    VK_HOME   : ItemIndex := 0;
    VK_END    : ItemIndex := ItemCount-1;
    VK_PRIOR  : ItemIndex := ItemIndex - (FMaxCountVisible-1);
    VK_NEXT   : ItemIndex := ItemIndex + (FMaxCountVisible-1);
  end;
end;
//****************************************************************************************************************************************************
procedure TiLinkedListBox.TimerEvent(Sender: TObject);
begin
  if FFirstTimerMessage then
    begin
      FTimer.Interval := FRepeatInterval;
      FFirstTimerMessage := False;
    end;

  if FButtonUpMouseDown   then DoButtonUpClick;
  if FButtonDownMouseDown then DoButtonDownClick;
end;
//****************************************************************************************************************************************************
procedure TiLinkedListBox.DoButtonDownClick;
begin
  if (FStartIndex + FMaxCountVisible - 1) < FLastIndex then Inc(FStartIndex);
  InvalidateChange;
end;
//****************************************************************************************************************************************************
procedure TiLinkedListBox.DoButtonUpClick;
begin
  if FStartIndex > 0 then Dec(FStartIndex);
  InvalidateChange;
end;
//****************************************************************************************************************************************************
procedure TiLinkedListBox.DoPageUpClick;
begin
  FStartIndex := FStartIndex - (FMaxCountVisible - 1);
  if FStartIndex < 0 then FStartIndex := 0;
  InvalidateChange;
end;
//****************************************************************************************************************************************************
procedure TiLinkedListBox.DoPageDownClick;
begin
  FStartIndex := FStartIndex + (FMaxCountVisible - 1);
  if (FStartIndex + (FMaxCountVisible - 1)) > FLastIndex then FStartIndex := FLastIndex - (FMaxCountVisible - 1);
  InvalidateChange;
end;
//****************************************************************************************************************************************************
procedure TiLinkedListBox.ScrollSelectedInView;
begin
  if      FItemIndex < FStartIndex                          then FStartIndex := FItemIndex
  else if FItemIndex > (FStartIndex + FMaxCountVisible - 1) then FStartIndex := FItemIndex - FMaxCountVisible + 1;
end;
//****************************************************************************************************************************************************
procedure TiLinkedListBox.iWantSpecialKey(var CharCode: Word; var Result: Longint);
begin
  inherited iWantSpecialKey(CharCode, Result);
  if CharCode in [VK_LEFT, VK_DOWN, VK_RIGHT, VK_UP] then Result := 1 else Result := 0;
end;
//****************************************************************************************************************************************************
end.