iswitchled.pas

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

    begin
      DrawBackGround(Canvas, BackGroundColor);
      DrawBorder(Canvas);

      DrawRect.Left   :=             (FBorderSize-2);
      DrawRect.Top    :=             (FBorderSize-2);
      DrawRect.Right  := Width  -1 - (FBorderSize-2);
      DrawRect.Bottom := Height -1 - (FBorderSize-2);

      DrawWidth       := DrawRect.Right  - DrawRect.Left;
      DrawHeight      := DrawRect.Bottom - DrawRect.Top;

      Font.Assign(FCaptionFont);

      if not FGlyph.Empty then
        begin
          TempWidth  := FGlyph.Width;
          TempHeight := FGlyph.Height;
        end
      else
        begin
          if FAutoLedSize then
            begin
              case FIndicatorAlignment of
                isaBottom : begin TempWidth := DrawWidth - 2*FIndicatorMargin; TempHeight := FIndicatorHeight;                end;
                isaTop    : begin TempWidth := DrawWidth - 2*FIndicatorMargin; TempHeight := FIndicatorHeight;                end;
                isaLeft   : begin TempWidth := FIndicatorWidth;                TempHeight := DrawHeight - 2*FIndicatorMargin; end;
                else        begin TempWidth := FIndicatorWidth;                TempHeight := DrawHeight - 2*FIndicatorMargin; end;
              end;
            end
          else
            begin
              TempWidth  := FIndicatorWidth;
              TempHeight := FIndicatorHeight;
            end;
        end;


      case FIndicatorAlignment of
        isaBottom : begin
                      LedRect := Rect(CenterPoint.X - TempWidth div 2, DrawRect.Bottom - FIndicatorMargin - TempHeight,
                                      CenterPoint.X + TempWidth div 2, DrawRect.Bottom - FIndicatorMargin);

                      ATextRect.Left  := DrawRect.Left;
                      ATextRect.Right := DrawRect.Right;

                      if FCaptionAlignment = islcaOppisiteSide then
                        begin
                          ATextFlags       := [itfHCenter, itfVTop];
                          ATextRect.Top    := DrawRect.Top + FCaptionMargin;
                          ATextRect.Bottom := LedRect.Top;
                        end
                      else
                        begin
                          ATextFlags       := [itfHCenter, itfVBottom];
                          ATextRect.Top    := DrawRect.Top;
                          ATextRect.Bottom := LedRect.Top - FCaptionMargin;
                        end;
                    end;
        isaTop    : begin
                      LedRect := Rect(CenterPoint.X - TempWidth div 2, DrawRect.Top + FIndicatorMargin,
                                      CenterPoint.X + TempWidth div 2, DrawRect.Top + FIndicatorMargin + TempHeight);

                      ATextRect.Left  := DrawRect.Left;
                      ATextRect.Right := DrawRect.Right;

                      if FCaptionAlignment = islcaOppisiteSide then
                        begin
                          ATextFlags       := [itfHCenter, itfVBottom];
                          ATextRect.Top    := LedRect.Bottom;
                          ATextRect.Bottom := DrawRect.Bottom - FCaptionMargin;
                        end
                      else
                        begin
                          ATextFlags       := [itfHCenter, itfVTop];
                          ATextRect.Top    := LedRect.Bottom + FCaptionMargin;
                          ATextRect.Bottom := DrawRect.Bottom;
                        end;
                    end;
        isaLeft   : begin
                      LedRect := Rect(Left + FIndicatorMargin,             CenterPoint.Y - TempHeight div 2,
                                      Left + FIndicatorMargin + TempWidth, CenterPoint.Y + TempHeight div 2);

                      ATextRect.Top    := DrawRect.Top;
                      ATextRect.Bottom := DrawRect.Bottom;

                      if FCaptionAlignment = islcaOppisiteSide then
                        begin
                          ATextFlags := [itfHRight, itfVCenter];
                          ATextRect.Left  := LedRect.Right;
                          ATextRect.Right := DrawRect.Right - FCaptionMargin;
                        end
                      else
                        begin
                          ATextFlags := [itfHLeft, itfVCenter];
                          ATextRect  := Rect(LedRect.Right + FCaptionMargin, DrawRect.Top, DrawRect.Right, DrawRect.Bottom);
                        end;
                    end;
        isaRight  : begin
                      LedRect := Rect(Right - FIndicatorMargin - TempWidth, CenterPoint.Y - TempHeight div 2,
                                      Right - FIndicatorMargin,             CenterPoint.Y + TempHeight div 2);

                      ATextRect.Top    := DrawRect.Top;
                      ATextRect.Bottom := DrawRect.Bottom;

                      if FCaptionAlignment = islcaOppisiteSide then
                        begin
                          ATextFlags := [itfHLeft, itfVCenter];
                          ATextRect.Left  := DrawRect.Left + FCaptionMargin;
                          ATextRect.Right := LedRect.Left;
                        end
                      else
                        begin
                          ATextFlags := [itfHRight, itfVCenter];
                          ATextRect.Left  := DrawRect.Left;
                          ATextRect.Right := LedRect.Left - FCaptionMargin;
                        end;
                   end;
      end;
                        ATextFlags := ATextFlags + [itfNoClip] + [itfShowPrefix];
      if FWordWrap then ATextFlags := ATextFlags + [itfWordBreak] else ATextFlags := ATextFlags + [itfSingleLine];


      if not Enabled then
        begin
          Font.Color := clBtnHighlight; OffsetRect(ATextRect, 1 , 1); iDrawText(Canvas, FCaption, ATextRect, ATextFlags);
          Font.Color := clBtnShadow;    OffsetRect(ATextRect,-1 ,-1); iDrawText(Canvas, FCaption, ATextRect, ATextFlags);
        end
      else
        begin
          if FMouseDown or FKeyDown  then OffsetRect(ATextRect, 1, 1);
          iDrawText(Canvas, FCaption, ATextRect, ATextFlags);
        end;

      if (FIndicatorHeight > 1) and (FIndicatorWidth > 1) or (not FGlyph.Empty) then
        begin
          Brush.Style := bsSolid;
          if Active then Brush.Color := ActiveColor else Brush.Color := DimColor(ActiveColor, 3);
          Pen.Color   := clBlack;

          with LedRect do
            begin
              if FMouseDown or FKeyDown then OffsetRect(LedRect, 1, 1);
              if FGlyph.Empty then
                begin
                  Rectangle(Left, Top, Right+1, Bottom+1);
                  Pen.Color := clWhite;
                  PolyLine([Point(Left, Bottom), Point(Right,Bottom), Point(Right, Top-1)]);
                end
              else
                begin
                  //KYLIX TODO
                  {$ifndef iCLX}
                  FGlyph.TransparentColor := FGlyph.Canvas.Pixels[0, FGlyph.Height-1];
                  {$endif}
                  Canvas.Draw(Left, Top, FGlyph);
                end;
            end;
        end;

    end;

  if ShowFocusRect and HasFocus then
    begin
      Canvas.Pen.Color   := clBtnFace;
      Canvas.Brush.Color := clBtnFace;
      InflateRect(DrawRect, -3, -3);
      iDrawFocusRect(Canvas, DrawRect, BackGroundColor);
    end;
end;
//*************************************************************************************************************************************
procedure TiSwitchLed.DrawEdgeTopLeft(Canvas: TCanvas; Offset: Integer; AColor: TColor);
var
  DrawRect : TRect;
begin
  with Canvas, DrawRect do
    begin
      DrawRect := Rect(0, 0, Width-1, Height-1);
      Pen.Color := AColor;
      Polyline([Point(Left + Offset, Top + Offset), Point(Right - Offset , Top    + Offset  )]);
      Polyline([Point(Left + Offset, Top + Offset), Point(Left  + Offset,  Bottom - Offset  )]);
    end;
end;
//*************************************************************************************************************************************
procedure TiSwitchLed.DrawEdgeBottomRight(Canvas: TCanvas; Offset: Integer; AColor: TColor);
var
  DrawRect : TRect;
begin
  with Canvas, DrawRect do
    begin
      DrawRect := Rect(0, 0, Width-1, Height-1);
      Pen.Color := AColor;
      Polyline([Point(Right - Offset, Bottom - Offset), Point(Right - Offset,     Top + Offset - 1)]);
      Polyline([Point(Right - Offset, Bottom - Offset), Point(Left  + Offset - 1, Bottom - Offset)]);
    end;
end;
//*************************************************************************************************************************************
procedure TiSwitchLed.DrawBorder(Canvas: TCanvas);
var
  x : Integer;
begin
  with Canvas do
    begin
      Brush.Style := bsClear;

      if not HasFocus then
        begin
          DrawEdgeTopLeft    (Canvas, 0, clBtnHighlight);
          DrawEdgeBottomRight(Canvas, 0, clBlack);

          for x := 1 to FBorderSize - 1 do
            begin
              DrawEdgeTopLeft    (Canvas, x, FBorderHighlightColor);
              DrawEdgeBottomRight(Canvas, x, FBorderShadowColor);
            end;
        end
      else
        begin
          if not (FMouseDown or FKeyDown) then
            begin
              DrawEdgeTopLeft    (Canvas, 0, cl3DDkShadow);
              DrawEdgeBottomRight(Canvas, 0, clBlack);

              DrawEdgeTopLeft    (Canvas, 1, FBorderHighlightColor);
              DrawEdgeBottomRight(Canvas, 1, FBorderShadowColor);

              for x := 2 to FBorderSize - 1 do
                begin
                  DrawEdgeTopLeft    (Canvas, x, FBorderHighlightColor);
                  DrawEdgeBottomRight(Canvas, x, FBorderShadowColor);
                end;

              DrawEdgeBottomRight(Canvas, FBorderSize, FBorderShadowColor);
            end
          else
            begin
              DrawEdgeTopLeft    (Canvas, 0, clBlack);
              DrawEdgeBottomRight(Canvas, 0, clBlack);

              DrawEdgeTopLeft    (Canvas, 1, cl3DDkShadow);
              DrawEdgeBottomRight(Canvas, 1, cl3DDkShadow);

              for x := 2 to FBorderSize - 1 do
                begin
                  DrawEdgeTopLeft    (Canvas, x, FBorderShadowColor);
                  DrawEdgeBottomRight(Canvas, x, FBorderHighlightColor);
                end;
            end;
        end;
    end;
end;
//*************************************************************************************************************************************
procedure TiSwitchLed.iDoKillFocus;
begin
  FMouseDown := False;
  FKeyDown   := False;
  InvalidateChange;
  inherited;
end;
//*************************************************************************************************************************************
//KYLIX TODO NOW
{$ifndef iCLX}
procedure TiSwitchLed.CMEnabledChanged(var Message: TMessage);
begin
  InvalidateChange;
  inherited;
end;
//*************************************************************************************************************************************
procedure TiSwitchLed.CMDialogChar(var Message: TCMDialogChar);
begin
  if Enabled then if IsAccel(Message.CharCode, Caption) and GetAltDown then
    begin
      SetFocus;
      InvalidateChange;
      FUserGenerated := True;
      try
        Active := not Active;
      finally
        FUserGenerated := False;
      end;
      Message.Result := 1;
    end;
end;
//*************************************************************************************************************************************
procedure TiSwitchLed.WMSysChar(var Message: TWMSysChar);
begin
  if Enabled then if IsAccel(Message.CharCode, Caption) then
    begin
      SetFocus;
      InvalidateChange;
      FUserGenerated := True;
      try
        Active := not Active;
      finally
        FUserGenerated := False;
      end;
      Message.Result := 1;
    end;
end;
{$endif}
//*************************************************************************************************************************************
procedure TiSwitchLed.DefineProperties(Filer: TFiler);
begin
  inherited DefineProperties(Filer);
  Filer.DefineProperty('Caption_2', ReadCaption, WriteCaption, True);
end;
//*************************************************************************************************************************************
procedure TiSwitchLed.ReadCaption(Reader: TReader);
begin
  FCaption := Reader.ReadString;
end;
//*************************************************************************************************************************************
procedure TiSwitchLed.WriteCaption(Writer: TWriter);
begin
  Writer.WriteString(FCaption);
end;
//*************************************************************************************************************************************
procedure TiSwitchLed.SetGlyph(const Value: TBitmap);
begin
  FGlyph.Assign(Value);
  FGlyph.Transparent     := True;
  FGlyph.TransparentMode := tmAuto;
  InvalidateChange;
end;
//*************************************************************************************************************************************
end.