icomponent.pas

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

begin
  if FUpdateActive then
    begin
      FNeedsInvalidateChange := True;
    end
  else if FAutoFrameRate then
    begin
      FNeedsInvalidateChange := True;
      DoFrameRate;
    end
  else DoRepaint;
end;
//****************************************************************************************************************************************************
procedure TiComponent.InvalidateNow;
begin
  DoRepaint;
end;
//****************************************************************************************************************************************************
procedure TiComponent.ShowOffScreenBitmap(Bitmap : TBitmap);
begin
  Canvas.Draw(0, 0, Bitmap);
end;
//****************************************************************************************************************************************************
procedure TiComponent.TransferBackGround (Canvas : TCanvas);begin Canvas.Draw(0, 0, FBackGroundBitmap);end;
procedure TiComponent.ShowBackGround;                       begin Canvas.Draw(0, 0, FBackGroundBitmap);end;
//****************************************************************************************************************************************************
procedure TiComponent.SetErrorActive         (const Value: Boolean);begin SetBooleanProperty(Value, FErrorActive,         irtBackGround);end;
procedure TiComponent.SetErrorText           (const Value: String );begin SetStringProperty (Value, FErrorText,           irtBackGround);end;
procedure TiComponent.SetErrorBackGroundColor(const Value: TColor );begin SetColorProperty  (Value, FErrorBackGroundColor,irtBackGround);end;
procedure TiComponent.SetBackGroundColor     (const Value: TColor );begin SetColorProperty  (Value, FBackGroundColor,     irtBackGround);end;
procedure TiComponent.SetOffsetX             (const Value: Integer);begin SetIntegerProperty(Value, FOffsetX,             irtBackGround);end;
procedure TiComponent.SetOffsetY             (const Value: Integer);begin SetIntegerProperty(Value, FOffsetY,             irtBackGround);end;
procedure TiComponent.SetUpdateFrameRate     (const Value: Integer);begin SetIntegerProperty(Value, FUpdateFrameRate,     irtBackGround);end;
//****************************************************************************************************************************************************
procedure TiComponent.SetErrorFont(const Value: TFont);
begin
  FErrorFont.Assign(Value);
end;
//****************************************************************************************************************************************************
procedure TiComponent.SetBorderStyle(const Value: TiBevelStyle);
begin
  if FBorderStyle <> Value then
    begin
      FBorderStyle := Value;
      BackGroundChange;
    end;
end;
//****************************************************************************************************************************************************
procedure TiComponent.SetAutoFrameRate(const Value: Boolean);
begin
  if FAutoFrameRate <> Value then
    begin
      FAutoFrameRate := Value;
      if not FAutoFrameRate then EndUpdate else BackGroundChange;
    end;
end;
//****************************************************************************************************************************************************
procedure TiComponent.DrawBackGround(Canvas : TCanvas; BackGroundColor: TColor);
var
  NeedsBackGroundPictureDrawn : Boolean;
begin
  FBackGroundChanged := False;
  with Canvas do
    begin
      NeedsBackGroundPictureDrawn := True;

      if Assigned(FBackGroundPicture) then
        begin
          if FBackGroundPicture.Width = 0 then NeedsBackGroundPictureDrawn := False;
        end
      else NeedsBackGroundPictureDrawn := False;

      if NeedsBackGroundPictureDrawn then
        begin
          Canvas.StretchDraw(Rect(0,0,Width, Height),FBackGroundPicture);
        end
      else
        begin
          Brush.Style := bsSolid;             
          Brush.Color := BackGroundColor;
          FillRect(Rect(0, 0, Width, Height));
          DrawBorder(Canvas);
        end;
    end;
end;
//****************************************************************************************************************************************************
procedure TiComponent.DrawBorder(Canvas : TCanvas);
var
  DrawRect : TRect;
begin
  with Canvas do
    begin
      DrawRect := Rect(0, 0, Width, Height);
      case FBorderStyle of
        ibsLowered : iDrawEdge(Canvas, DrawRect, idesSunken);
        ibsRaised  : iDrawEdge(Canvas, DrawRect, idesRaised);
      end;
    end;
end;
//****************************************************************************************************************************************************
procedure TiComponent.RepaintAll;
begin
  BackGroundChange;
end;
//****************************************************************************************************************************************************
procedure TiComponent.ResetBackGroundChange;
begin
  FBackGroundChanged := False;
end;
//****************************************************************************************************************************************************
function TiComponent.GetCenterPoint(Canvas:TCanvas): TPoint;
begin
  Result := Point((Width) div 2 + OffsetX, (Height) div 2 + OffsetY);
end;
//****************************************************************************************************************************************************
function TiComponent.GetCenterPointDouble(Canvas:TCanvas): TPointDouble;
begin
  Result.x := (Width  - 1)/2;
  Result.y := (Height - 1)/2;
end;
//****************************************************************************************************************************************************
function TiComponent.GetXYRadPoint(AngleDegrees, Radius: Double; Offset : TPoint) : TPoint;
begin
  Result := Point(Offset.x + Round(Cos(DegToRad(AngleDegrees))*Radius),Offset.y - Round(Sin(DegToRad(AngleDegrees))*Radius));
end;
//****************************************************************************************************************************************************
procedure TiComponent.BackGroundChangeEvent(Sender: TObject);
begin
  BackGroundChange;
end;
//****************************************************************************************************************************************************
procedure TiComponent.InvalidateChangeEvent(Sender: TObject);
begin
  InvalidateChange;
end;
//****************************************************************************************************************************************************
procedure TiComponent.InvalidateNowEvent(Sender: TObject);
begin
  InvalidateNow;
end;
//****************************************************************************************************************************************************
procedure TiComponent.SetBooleanProperty(Value: Boolean; var FVariable: Boolean; RepaintType : TiRepaintType);
begin
  if FVariable <> Value then
    begin
      FVariable := Value;
      DoRepaintType(RepaintType);
    end;
end;
//****************************************************************************************************************************************************
procedure TiComponent.SetIntegerProperty(Value: Integer; var FVariable: Integer; RepaintType : TiRepaintType);
begin
  if FVariable <> Value then
    begin
      FVariable := Value;
      DoRepaintType(RepaintType);
    end;
end;
//****************************************************************************************************************************************************
procedure TiComponent.SetDoubleProperty(Value: Double; var FVariable: Double; RepaintType: TiRepaintType);
begin
  if FVariable <> Value then
    begin
      FVariable := Value;
      DoRepaintType(RepaintType);
    end;
end;
//****************************************************************************************************************************************************
procedure TiComponent.SetStringProperty(Value: String; var FVariable: String; RepaintType: TiRepaintType);
begin
  if FVariable <> Value then
    begin
      FVariable := Value;
      DoRepaintType(RepaintType);
    end;
end;
//****************************************************************************************************************************************************
procedure TiComponent.SetWideStringProperty(Value: WideString; var FVariable: WideString; RepaintType: TiRepaintType);
begin
  if FVariable <> Value then
    begin
      FVariable := Value;
      DoRepaintType(RepaintType);
    end;
end;
//****************************************************************************************************************************************************
procedure TiComponent.SetColorProperty(Value: TColor; var FVariable: TColor; RepaintType : TiRepaintType);
begin
  if FVariable <> Value then
    begin
      FVariable := Value;
      DoRepaintType(RepaintType);
    end;
end;
//****************************************************************************************************************************************************
function TiComponent.GetLoading: Boolean;
begin
  Result := False;
  if csLoading in ComponentState then Result := True;
  if FLoading                    then Result := True;
end;
//****************************************************************************************************************************************************
procedure TiComponent.DoRepaintType(Value: TiRepaintType);
begin
  case Value of
    irtInvalidate : InvalidateChange;
    irtBackGround : BackGroundChange;
  end;
end;
//****************************************************************************************************************************************************
procedure TiComponent.CreateOffScreenBitmap;
begin
  FOffScreenBitmap         := TBitmap.Create;
  FOffScreenBitmap.Width   := Width;
  FOffScreenBitmap.Height  := Height;
end;
//****************************************************************************************************************************************************
procedure TiComponent.CreateBackGroundBitmap;
begin
  if not Assigned(FBackGroundBitmap) then
    begin
      FBackGroundBitmap        := TBitmap.Create;
      FBackGroundBitmap.Width  := Width;
      FBackGroundBitmap.Height := Height;
    end;
end;
//****************************************************************************************************************************************************
procedure TiComponent.CreateBackGroundPicture;
begin
  FBackGroundPicture          := TBitmap.Create;
  FBackGroundPicture.OnChange := BackGroundChangeEvent;
end;
//****************************************************************************************************************************************************
function TiComponent.GetBackGroundBitmap: TBitmap;
begin
  CreateBackGroundBitmap;
  Result := FBackGroundBitmap;
end;
//****************************************************************************************************************************************************
procedure TiComponent.Paint;
{$IFDEF EVAL}
const
  Minutes10 = 1/(24*60)*10;
var
  HasExpired : Boolean;
{$ENDIF}
begin
  {$IFDEF EVAL}
  HasExpired := False;
  if Now < FCreationTime               then HasExpired := True;
  if Now > (FCreationTime + Minutes10) then HasExpired := True;
  if FFirstEvalExpiredPainted          then HasExpired := True;

  if HasExpired then
    begin
      PaintEvalExpired;
      if not FFirstEvalExpiredPainted then
        begin
          FFirstEvalExpiredPainted := True;
          InvalidateNow;
        end;
      Exit;
    end;
  {$ENDIF}
  {$IFDEF iVCL}if GetDeviceCaps(Canvas.Handle, TECHNOLOGY) = DT_METAFILE then PaintToMetaFile else PaintToDC;{$ENDIF}
  {$IFDEF iCLX}                                                                                    PaintToDC;{$ENDIF}
end;
//****************************************************************************************************************************************************
procedure TiComponent.PaintEvalExpired;
var
  ARect       : TRect;
  AText       : String;
  ATextHeight : Integer;
begin
  with Canvas do
    begin
      AText := 'Evaluation 10 Minute Limit Exceeded';
      ARect := Rect(0, 0, Width, Height);
      Brush.Color := clBlack;
      Font.Color  := clWhite;
      FillRect(ARect);

      ATextHeight := iDrawText(Canvas, AText, ARect, [itfHCenter, itfVCenter, itfWordBreak, itfCalcRect, itfNoClip]);

      ARect := Rect(0,     Height div 2 - ATextHeight div 2,
                    Width, Height div 2 + ATextHeight div 2);

      iDrawText(Canvas, AText, ARect, [itfHCenter, itfVCenter, itfWordBreak,  itfNoClip])
    end;
end;
//****************************************************************************************************************************************************
procedure TiComponent.PaintToMetaFile;
var
  OldCachedDrawing : Boolean;
begin
  try
    Lock;
    try
      OldCachedDrawing := FCachedDrawing;
      FCachedDrawing := False;
      try
        iPaintTo(Canvas);
      finally
        FCachedDrawing := OldCachedDrawing;
      end;
    finally
      Unlock;
    end;
  except
    on exception do;
  end;
end;
//****************************************************************************************************************************************************
procedure TiComponent.PaintToDC;
var
  ARect : TRect;
begin
  try                                                                                                      
    Lock;
    try
      CreateOffScreenBitmap;
      try
        FOffScreenBitmap.Canvas.Brush.Style := bsSolid;
        FOffScreenBitmap.Canvas.Pen.Style   := psSolid;
        try
          iPaintTo(FOffScreenBitmap.Canvas);
        except
          on e: Exception do
            begin
              with FOffScreenBitmap.Canvas do
                begin
                  ARect := GetClientRect;
                  Brush.Color := clBlack;            
                  FillRect(ARect);