qiledmatrix.pas

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

                    begin
                      if not Transparent and (FIndicatorStyle <> ilmisRound) then
                        begin
                          LedCacheObject := FLedCache.Find(IndicatorData.Color);
                          if not Assigned(LedCacheObject) then
                            begin
                              ARect := Rect(0, 0, FIndicatorWidth, FIndicatorHeight);

                              LedCacheObject                     := TLedCacheObject.Create;
                              LedCacheObject.Color               := IndicatorData.Color;
                              LedCacheObject.ActiveBitmap        := TBitmap.Create;
                              LedCacheObject.ActiveBitmap.Width  := FIndicatorWidth;
                              LedCacheObject.ActiveBitmap.Height := FIndicatorHeight;

                              case FIndicatorStyle of
                                ilmisRound     : DrawRound    (LedCacheObject.ActiveBitmap.Canvas, ARect, True, IndicatorData.Color);
                                ilmisRectangle : DrawRectangle(LedCacheObject.ActiveBitmap.Canvas, ARect, True, IndicatorData.Color);
                              end;
                              LedCacheObject.InactiveBitmap        := TBitmap.Create;
                              LedCacheObject.InactiveBitmap.Width  := FIndicatorWidth;
                              LedCacheObject.InactiveBitmap.Height := FIndicatorHeight;

                              case FIndicatorStyle of
                                ilmisRound     : DrawRound    (LedCacheObject.InactiveBitmap.Canvas, ARect, False, IndicatorData.Color);
                                ilmisRectangle : DrawRectangle(LedCacheObject.InactiveBitmap.Canvas, ARect, False, IndicatorData.Color);
                              end;
                              FLedCache.Add(LedCacheObject);
                            end;

                          case IndicatorData.Active of
                            False : BackGroundBitmap.Canvas.Draw(CurrentLeft, CurrentTop, LedCacheObject.InactiveBitmap);
                            True  : BackGroundBitmap.Canvas.Draw(CurrentLeft, CurrentTop, LedCacheObject.ActiveBitmap);
                          end;
                        end
                      else
                        DrawRound(BackGroundBitmap.Canvas, Rect(CurrentLeft,CurrentTop,CurrentLeft+FIndicatorWidth,CurrentTop+FIndicatorWidth), IndicatorData.Active, IndicatorData.Color);

                      if Trim(IndicatorData.Caption) <> '' then
                        begin
                          case IndicatorData.Active of
                            False : Font.Assign(FIndicatorCaptionInactiveFont);
                            True  : Font.Assign(FIndicatorCaptionActiveFont);
                          end;

                          Brush.Style := bsClear;
                          ARect       := Rect(CurrentLeft+1, CurrentTop+1, CurrentLeft + FIndicatorWidth-1, CurrentTop + FIndicatorHeight-1);

                          CenterY := (ARect.Bottom + ARect.Top) div 2;

                          TempRect := ARect;
                          ATextHeight := iDrawText(Canvas, IndicatorData.Caption, TempRect, [itfHCenter, itfVTop, itfNoClip, itfCalcRect]);

                          ARect.Top    := CenterY               - ATextHeight div 2;
                          ARect.Bottom := CenterY + ATextHeight - ATextHeight div 2;

                          iDrawText(Canvas, IndicatorData.Caption, ARect, [itfHCenter, itfVCenter]);
                        end;

                      FIndicatorList^[Col + Row*ColCount].Dirty := False;
                    end;
                   CurrentTop := CurrentTop + FIndicatorHeight + FSpacingVertical;
                end;
              CurrentLeft := CurrentLeft + FIndicatorWidth + FSpacingHorizontal;
            end;
        end;
      ResetBackGroundChange;
    end;
  TransferBackGround(Canvas);
end;
//****************************************************************************************************************************************************
procedure TiLedMatrix.iPaintNonCached(Canvas: TCanvas);
var
  Row, Col      : Integer;
  CurrentLeft   : Integer;
  CurrentTop    : Integer;
  ARect         : TRect;
  TempRect      : TRect;
  IndicatorData : TIndicatorData;
  CenterY       : Integer;
  ATextHeight   : Integer;
begin
  DrawBackGround(Canvas, BackGroundColor);

  with Canvas do
    begin
      CurrentLeft := (Width - (FIndicatorWidth + FSpacingHorizontal)*FColCount) div 2 + 1;

      for Col := 0 to FColCount - 1 do
        begin
          CurrentTop := (Height - (FIndicatorHeight + FSpacingVertical)*FRowCount) div 2 + 1;
          for Row := 0 to FRowCount - 1 do
            begin
              ARect := Rect(CurrentLeft, CurrentTop, CurrentLeft + FIndicatorWidth, CurrentTop + FIndicatorHeight);

              FIndicatorList^[Col + Row*ColCount].ARect := ARect;

              IndicatorData := FIndicatorList^[Col + Row*ColCount];

              case FIndicatorStyle of
                ilmisRound     : DrawRound    (Canvas, ARect, IndicatorData.Active, IndicatorData.Color);
                ilmisRectangle : DrawRectangle(Canvas, ARect, IndicatorData.Active, IndicatorData.Color);
              end;

              if Trim(IndicatorData.Caption) <> '' then
                begin
                  case IndicatorData.Active of
                    False : Font.Assign(FIndicatorCaptionInactiveFont);
                    True  : Font.Assign(FIndicatorCaptionActiveFont);
                  end;

                  Brush.Style := bsClear;
                  ARect       := Rect(CurrentLeft+1, CurrentTop+1, CurrentLeft + FIndicatorWidth-1, CurrentTop + FIndicatorHeight-1);

                  CenterY := (ARect.Bottom + ARect.Top) div 2;

                  TempRect := ARect;
                  ATextHeight := iDrawText(Canvas, IndicatorData.Caption, TempRect, [itfHCenter, itfVTop, itfNoClip, itfCalcRect]);

                  ARect.Top    := CenterY               - ATextHeight div 2;
                  ARect.Bottom := CenterY + ATextHeight - ATextHeight div 2;

                  iDrawText(Canvas, IndicatorData.Caption, ARect, [itfHCenter, itfVCenter]);
                end;
               CurrentTop := CurrentTop + FIndicatorHeight + FSpacingVertical;
            end;
          CurrentLeft := CurrentLeft + FIndicatorWidth + FSpacingHorizontal;
        end;
    end;
end;
//****************************************************************************************************************************************************
procedure TiLedMatrix.DrawRectangle(Canvas: TCanvas; DrawRect: TRect; Active: Boolean; AColor: TColor);
begin
  with Canvas, DrawRect do
    begin
      if Active then
        begin
          Brush.Color := AColor;
          Pen.Color   := AColor;
        end
      else
        begin
          Brush.Color := DimColor(AColor, 3);
          Pen.Color   := DimColor(AColor, 3);
        end;

      Brush.Style := bsSolid;
      Pen.Style   := psSolid;

      Rectangle(Left, Top, Right, Bottom);

      case FIndicatorBevelStyle of
        ibsLowered : iDrawEdge(Canvas, Rect(Left, Top, Right, Bottom), idesSunken);
        ibsRaised  : iDrawEdge(Canvas, Rect(Left, Top, Right, Bottom), idesRaised);
      end;

      if FIndicatorShowReflection then
        begin
          if Active then Pen.Color := clWhite else Pen.Color := AColor;
          Polyline([Point(Left+3, Top+3), Point(Left+5, Top+3)]);
        end;
    end;
end;
//****************************************************************************************************************************************************
procedure TiLedMatrix.DrawRound(Canvas: TCanvas; DrawRect: TRect; Active: Boolean; AColor: TColor);
var
  {$ifdef iVCL}
  SizeDiv2 : Integer;
  {$endif}
  SizeDiv4 : Integer;
  ARect    : TRect;
begin
  with Canvas do
    begin
      if Active then
        begin
          Brush.Color := AColor;
          Pen.Color   := AColor;
        end
      else
        begin
          Brush.Color := DimColor(AColor, 3);
          Pen.Color   := DimColor(AColor, 3);
        end;

      Brush.Style := bsSolid;
      Pen.Style   := psSolid;

      {$ifdef iVCL}
      SizeDiv2 := FIndicatorWidth div 2;
      {$endif}
      SizeDiv4 := FIndicatorWidth div 4;

      with DrawRect do
        begin
          Ellipse(Left, Top, Right, Bottom);

          if FIndicatorShowReflection then
            begin
              if Active then Pen.Color := clWhite else Pen.Color := AColor;

              {$ifdef iVCL}
              Arc(Left + SizeDiv4,  Top + SizeDiv4,  Right - SizeDiv4,  Bottom - SizeDiv4,  Right - SizeDiv2,Top,Left,Bottom - SizeDiv2);
              Arc(Left + SizeDiv4+1,Top + SizeDiv4+1,Right - SizeDiv4-1,Bottom - SizeDiv4-1,Right - SizeDiv2,Top,Left,Bottom - SizeDiv2);
              {$endif}
              {$ifdef iCLX}
              ARect := Rect(Left + SizeDiv4,  Top + SizeDiv4,  Right - SizeDiv4,  Bottom - SizeDiv4);
              Arc(ARect.Left,  ARect.Top,  ARect.Right - ARect.Left,  ARect.Bottom - ARect.Top, 90*16, 90*16);

              InflateRect(ARect, 1, 1);
              Arc(ARect.Left,  ARect.Top,  ARect.Right - ARect.Left,  ARect.Bottom - ARect.Top, 90*16, 90*16);
              {$endif}
            end;

          case FIndicatorBevelStyle of
            ibsLowered :   begin
                             Pen.Color := clBtnShadow;
                             Arc(Left,   Top,   Right,   Bottom,   Right,   Top,   Left,   Bottom);
                             Arc(Left+1, Top+1, Right-1, Bottom-1, Right-1, Top+1, Left+1, Bottom-1);

                             Pen.Color := clBtnHighlight;
                             Arc(Left,   Top,   Right,   Bottom,   Left,   Bottom,   Right,   Top);
                             Arc(Left+1, Top+1, Right-1, Bottom-1, Left+1, Bottom-1, Right-1, Top+1);
                           end;
            ibsRaised    : begin
                             Pen.Color := clBtnHighlight;
                             Arc(Left,   Top,   Right,   Bottom,   Right,   Top,   Left,   Bottom);
                             Arc(Left+1, Top+1, Right-1, Bottom-1, Right-1, Top+1, Left+1, Bottom-1);

                             Pen.Color := clBtnShadow;
                             Arc(Left,   Top,   Right,   Bottom,   Left,   Bottom,   Right,   Top);
                             Arc(Left+1, Top+1, Right-1, Bottom-1, Left+1, Bottom-1, Right-1, Top+1);
                           end;
          end;
        end;
    end;
end;
//****************************************************************************************************************************************************
{ TLedCache }
//****************************************************************************************************************************************************
constructor TLedCache.Create;
begin
  inherited;
  FCacheList := TList.Create;
end;
//****************************************************************************************************************************************************
destructor TLedCache.Destroy;
begin
  Clear;
  FCacheList.Free;
  inherited;
end;
//****************************************************************************************************************************************************
procedure TLedCache.Clear;
begin
  while FCacheList.Count > 0 do
    begin
      TLedCacheObject(FCacheList.Items[0]).Free;
      FCacheList.Delete(0);
    end;
end;
//****************************************************************************************************************************************************
procedure TLedCache.Add(LedCacheObject: TLedCacheObject);
begin
  if FCacheList.Count = 10 then
    begin
      TObject(FCacheList.Items[0]).Free;
      FCacheList.Delete(0);
    end;
  FCacheList.Add(LedCacheObject);
end;
//****************************************************************************************************************************************************
function TLedCache.Find(AColor: TColor): TLedCacheObject;
var
  x : Integer;
begin
  Result := nil;
  for x := 0 to FCacheList.Count -1 do
    begin
      if TLedCacheObject(FCacheList.Items[x]).Color = AColor then
        begin
          Result := TLedCacheObject(FCacheList.Items[x]);
          Break;
        end;
    end;
end;
//****************************************************************************************************************************************************
{ TLedCacheObject }
destructor TLedCacheObject.Destroy;
begin
  ActiveBitmap.Free;
  InActiveBitmap.Free;
  inherited;
end;
//****************************************************************************************************************************************************
{$ifdef iVCL}
function TiLedMatrix.OPCNewDataSpecial(iOPCItem: TiOPCItem): Boolean;
var
  x : Integer;
begin
  Result := inherited OPCNewDataSpecial(iOPCItem);

  for x := 0 to ColCount*RowCount-1 do
    if UpperCase('Row(' + IntToStr(x div ColCount) + ')Col(' + IntToStr(x mod ColCount) + ').Active') = UpperCase(iOPCItem.PropertyName) then
      begin
        Result := True;
        IndicatorActive[x div ColCount, x mod ColCount] := iOPCItem.Data;
      end;
end;
//****************************************************************************************************************************************************
procedure TiLedMatrix.UpdateOPCSpecialList;
var
  x : Integer;
begin
  if not Assigned(OPCSpecialList) then Exit;
  OPCSpecialList.Clear;
  for x := 0 to ColCount*RowCount-1 do
    OPCSpecialList.Add('Row(' + IntToStr(x div ColCount) + ')Col(' + IntToStr(x mod ColCount) + ').Active');
end;
{$endif}
//****************************************************************************************************************************************************
end.