iradiogroup.pas

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

              Pen.Color := clBtnShadow;
              PolyLine([Point(ItemCenterX-5, ItemCenterY-2), Point(ItemCenterX-5, ItemCenterY+2)]);
              PolyLine([Point(ItemCenterX-4, ItemCenterY+2), Point(ItemCenterX-4, ItemCenterY+4)]);
              PolyLine([Point(ItemCenterX-4, ItemCenterY-3), Point(ItemCenterX-4, ItemCenterY-5)]);
              PolyLine([Point(ItemCenterX-3, ItemCenterY-5), Point(ItemCenterX-1, ItemCenterY-5)]);
              PolyLine([Point(ItemCenterX-1, ItemCenterY-6), Point(ItemCenterX+3, ItemCenterY-6)]);
              PolyLine([Point(ItemCenterX+3, ItemCenterY-5), Point(ItemCenterX+5, ItemCenterY-5)]);

              Pen.Color := clBtnFace;
              PolyLine([Point(ItemCenterX+6, ItemCenterY-3), Point(ItemCenterX+6, ItemCenterY-5)]);
              PolyLine([Point(ItemCenterX+6, ItemCenterY+2), Point(ItemCenterX+6, ItemCenterY+6)]);
              PolyLine([Point(ItemCenterX+5, ItemCenterY-2), Point(ItemCenterX+5, ItemCenterY+2)]);
              PolyLine([Point(ItemCenterX+4, ItemCenterY-3), Point(ItemCenterX+4, ItemCenterY-2)]);
              PolyLine([Point(ItemCenterX+4, ItemCenterY+2), Point(ItemCenterX+4, ItemCenterY+4)]);
              PolyLine([Point(ItemCenterX+5, ItemCenterY+4), Point(ItemCenterX+5, ItemCenterY+6)]);
              PolyLine([Point(ItemCenterX-5, ItemCenterY+5), Point(ItemCenterX-1, ItemCenterY+5)]);
              PolyLine([Point(ItemCenterX+3, ItemCenterY+5), Point(ItemCenterX+5, ItemCenterY+5)]);
              PolyLine([Point(ItemCenterX-1, ItemCenterY+4), Point(ItemCenterX+3, ItemCenterY+4)]);
              PolyLine([Point(ItemCenterX+3, ItemCenterY+3), Point(ItemCenterX+4, ItemCenterY+3)]);
              PolyLine([Point(ItemCenterX-3, ItemCenterY+3), Point(ItemCenterX-1, ItemCenterY+3)]);

              Pen.Color := clBtnHighlight;
              PolyLine([Point(ItemCenterX+5, ItemCenterY-3), Point(ItemCenterX+5, ItemCenterY-5)]);
              PolyLine([Point(ItemCenterX+6, ItemCenterY-2), Point(ItemCenterX+6, ItemCenterY+2)]);
              PolyLine([Point(ItemCenterX+5, ItemCenterY+2), Point(ItemCenterX+5, ItemCenterY+4)]);
              PolyLine([Point(ItemCenterX+3, ItemCenterY+4), Point(ItemCenterX+5, ItemCenterY+4)]);
              PolyLine([Point(ItemCenterX-1, ItemCenterY+5), Point(ItemCenterX+3, ItemCenterY+5)]);
              PolyLine([Point(ItemCenterX-3, ItemCenterY+4), Point(ItemCenterX-1, ItemCenterY+4)]);

              Brush.Style := bsClear;
              Font.Color := FFont.Color;
              ATextRect := Rect(ItemCenterX + 12,                    ItemCenterY - TextHeight(AText) div 2,
                                ItemCenterX + 12 + TextWidth(AText), ItemCenterY + TextHeight(AText) div 2);
              iDrawText(Canvas, AText, ATextRect, [itfHLeft, itfVCenter, itfNoClip]);

              if (x = FItemIndex) then
                begin
                  Brush.Color := clBlack;
                  Brush.Style := bsSolid;
                  Pen.Color   := clBlack;
                  Pen.Style   := psSolid;

                  Ellipse(ItemCenterX - 1, ItemCenterY-2, ItemCenterX + 3, ItemCenterY+2);
                end;

              if HasFocus then
                begin
                  ShowFocus := False;
                  if (FMouseDown) and (x = FMouseDownIndex) then ShowFocus := True;
                  if (x = FItemIndex) and (not FMouseDown) then ShowFocus := True;
                  if ShowFocus then
                    begin
                      ATextRect.Left   := ATextRect.Left   - 1;
                      ATextRect.Right  := ATextRect.Right  + 1;
                      ATextRect.Top    := ATextRect.Top    - 1;
                      ATextRect.Bottom := ATextRect.Bottom + 3;

                      Font.Color  := clWhite;
                      Brush.Color := clBlack;
                      iDrawFocusRect2(Canvas, ATextRect);
                    end
                end;
            end;
        end;
    end;
end;
//****************************************************************************************************************************************************
function TiRadioGroup.GetMouseItemIndex(X, Y: Integer): Integer;
var
  Col : Integer;
  Row : Integer;
begin
  if FColumns = 1 then
    begin
      Result := Round((Y - FItemsRowStart)/ FItemsRowSpacing);
    end
  else
    begin
      Col := Trunc((X - FItemsColStart + 6)/ FItemsColSpacing);
      Row := Round((Y - FItemsRowStart)/ FItemsRowSpacing);
      Result := Col*FMaxRows + Row;
    end;
end;
//****************************************************************************************************************************************************
procedure TiRadioGroup.iDoKillFocus;
begin
  FMouseDown := False;
  FKeyDown   := False;
  InvalidateChange;
  inherited;
end;
//*************************************************************************************************************************************
procedure TiRadioGroup.iWantSpecialKey(var CharCode: Word; var Result: Longint);
begin
  Result := 0;
 if CharCode in [VK_LEFT, VK_DOWN, VK_RIGHT, VK_UP] then Result := 1;
end;
//****************************************************************************************************************************************************
procedure TiRadioGroup.iKeyDown(var CharCode: Word; Shift: TShiftState);
begin
  FKeyDown := True;
  if      CharCode in [VK_DOWN, VK_RIGHT] then
    begin
      CharCode := 0;
      if ItemIndex = Items.Count-1 then ItemIndex := 0
        else                            ItemIndex := ItemIndex +1;
    end
  else if CharCode in [VK_UP, VK_LEFT]    then
    begin
      CharCode := 0;
      if ItemIndex = 0 then ItemIndex := Items.Count-1
        else                ItemIndex := ItemIndex  -1;
    end;
  InvalidateChange;
end;
//****************************************************************************************************************************************************
procedure TiRadioGroup.iKeyUp(var CharCode: Word; Shift: TShiftState);
begin
  if CharCode = 32 then
    if FKeyDown then
      begin
        InvalidateChange;
        FUserGenerated := True;
        try                           

        finally
          FUserGenerated := False;
        end;
      end;
  FKeyDown := False;
  InvalidateChange;
end;
//****************************************************************************************************************************************************
procedure TiRadioGroup.iMouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then
    begin
      iSetFocus(Self);
      FMouseDown := True;
      FMouseDownIndex := GetMouseItemIndex(X, Y);
      InvalidateChange;
    end;
end;
//****************************************************************************************************************************************************
procedure TiRadioGroup.iMouseMove(Shift: TShiftState; X, Y: Integer);
begin
  if FmouseDown then
    begin
      FMouseDownIndex := GetMouseItemIndex(X, Y);
      InvalidateChange;
    end;
end;
//****************************************************************************************************************************************************
procedure TiRadioGroup.iMouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if FMouseDown then
    begin
      InvalidateChange;
      FMouseDown     := False;
      FUserGenerated := True;
      try
        if (FMouseDownIndex >= 0) and (FMouseDownIndex < FItems.Count) then
          begin
            if FMouseDownIndex = GetMouseItemIndex(X, Y) then ItemIndex := FMouseDownIndex;
          end;
      finally
        FUserGenerated := False;
      end;
    end;
end;
//****************************************************************************************************************************************************
procedure TiRadioGroup.iDoSetFocus;
begin
  inherited;
  InvalidateNow;
end;
//****************************************************************************************************************************************************
procedure TiRadioGroup.SubObjectChange(Sender: TObject);
begin
  if FItemIndex < -1             then FItemIndex := -1;
  if FItemIndex > FItems.Count-1 then FItemIndex := FItems.Count-1;
  InvalidateChange;
end;
//****************************************************************************************************************************************************
procedure TiRadioGroup.SetFont(const Value: TFont);
begin
  FFont.Assign(Value);
end;
//****************************************************************************************************************************************************
procedure TiRadioGroup.SetItems(const Value: TStrings);
begin
  FItems.Assign(Value);
end;
//****************************************************************************************************************************************************
procedure TiRadioGroup.SetItemIndex(const Value: Integer);
var
  TempItemIndex : Integer;
begin
  TempItemIndex := Value;
  if TempItemIndex < -1             then TempItemIndex := -1;
  if TempItemIndex > FItems.Count-1 then TempItemIndex := FItems.Count-1;
  if FItemIndex <> TempItemIndex then
    begin
      FItemIndex      := TempItemIndex;
      FMouseDownIndex := FItemIndex;
      InvalidateChange;
      DoChange;
    end;
end;
//****************************************************************************************************************************************************
procedure TiRadioGroup.SetColumns(const Value: Integer);
begin
  if Value < 1 then Exit;
  if FColumns <> Value then
    begin
      FColumns := Value;
      InvalidateChange;
    end;
end;
//****************************************************************************************************************************************************
end.