igpfunctions.pas

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

    begin
      Result.Left  := MinX;
      Result.Right := MaxX;
    end
  else
    begin
      Center := (MinX + MaxX) div 2;
      Result.Left  := Center -                 MinSizePixels div 2;
      Result.Right := Center + MinSizePixels - MinSizePixels div 2;
    end;

  if (MaxY - MinY) > MinSizePixels then
    begin
      Result.Top    := MinY;
      Result.Bottom := MaxY;
    end
  else
    begin
      Center := (MinY + MaxY) div 2;
      Result.Top    := Center -                 MinSizePixels div 2;
      Result.Bottom := Center + MinSizePixels - MinSizePixels div 2;
    end;
end;
//****************************************************************************************************************************************************
function GetShiftDown: Boolean;
begin
  {$IFDEF MSWINDOWS}
  Result := GetKeyState(iVK_SHIFT) < 0;
  {$ENDIF}

  {$IFDEF LINUX}
  Result := ssShift in Application.KeyState;
  {$ENDIF}
end;
//****************************************************************************************************************************************************
function GetCtrlDown: Boolean;
begin
  {$IFDEF MSWINDOWS}
  Result := GetKeyState(iVK_CONTROL) < 0;
  {$ENDIF}

  {$IFDEF LINUX}
  Result := ssCtrl in Application.KeyState;
  {$ENDIF}
end;
//****************************************************************************************************************************************************
function GetAltDown: Boolean;
begin
  {$IFDEF MSWINDOWS}
  Result := GetKeyState(iVK_MENU) < 0;
  {$ENDIF}

  {$IFDEF LINUX}
  Result := ssAlt in Application.KeyState;
  {$ENDIF}
end;
//****************************************************************************************************************************************************
procedure iDecodeDate(const DateTime: TDateTime; var Year, Month, Day: Integer);
var
  AYear, AMonth, ADay : Word;
begin
  DecodeDate(DateTime, AYear, AMonth, ADay);
  Year  := AYear;
  Month := AMonth;
  Day   := ADay;
end;
//****************************************************************************************************************************************************
procedure SwapIntegers(var Integer1, Integer2 : Integer);
var
  TempInteger: Integer;
begin
  TempInteger := Integer1;
  Integer1    := Integer2;
  Integer2    := TempInteger;
end;
//****************************************************************************************************************************************************
function iRect(Left, Top, Right, Bottom: Integer): TRect;
begin
  if Right > Left then
    begin
      Result.Left  := Left;
      Result.Right := Right;
    end
  else
    begin
      Result.Left  := Right;
      Result.Right := Left;
    end;

  if Bottom > Top then
    begin
      Result.Top  := Top;
      Result.Bottom := Bottom;
    end
  else
    begin
      Result.Top    := Bottom;
      Result.Bottom := Top;
    end;
end;
//****************************************************************************************************************************************************
procedure iRectangle(Canvas: TCanvas; ARect: TRect);
var
  NewRect : TRect;
begin
  NewRect := iRect(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);
  Canvas.Rectangle(NewRect.Left, NewRect.Top, NewRect.Right, NewRect.Bottom);
end;
//****************************************************************************************************************************************************
function  iXYReverseRect(XYReverse: Boolean; XAxis1, YAxis1, XAxis2, YAxis2: Integer): TRect;
begin
  if XYReverse then
       Result := iRect(YAxis1, XAxis1, YAXis2, XAxis2)
  else Result := iRect(XAxis1, YAxis1, XAxis2, YAxis2);
end;
//****************************************************************************************************************************************************
function  iXYReversePoint(XYReverse: Boolean; XAxisValue, YAxisValue: Integer): TPoint;
begin
  if XYReverse then
       Result := Point(YAxisValue, XAxisValue)
  else Result := Point(XAxisValue, YAxisValue);
end;
//****************************************************************************************************************************************************
procedure DrawGradient(ACanvas: TCanvas; BackColor, ShawdowColor: TColor; ARect: TRect; ReverseColors: Boolean);
var
  Red, Green, Blue : Integer;
  StartRed         : Integer;
  StartGreen       : Integer;
  StartBlue        : Integer;
  StopRed          : Integer;
  StopGreen        : Integer;
  StopBlue         : Integer;
  i, x, y          : Integer;
  NumOfLines       : Integer;
  CenterPoint      : TPoint;
  LastX            : Integer;
  Radius           : Integer;
begin
  with ACanvas, ARect do
    begin
      Pen.Style := psSolid;

      StartRed   := iGetRValue(ColorToRGB(clWhite));
      StartGreen := iGetGValue(ColorToRGB(clWhite));
      StartBlue  := iGetBValue(ColorToRGB(clWhite));

      StopRed    := iGetRValue(ShawdowColor);
      StopGreen  := iGetGValue(ShawdowColor);
      StopBlue   := iGetBValue(ShawdowColor);

      Radius      := (Right - Left + 1) div 2;
      NumOfLines  := Radius*4;

      if NumOfLines = 0 then exit;

      for x := 0 to NumOfLines-1 do
        begin
          if ReverseColors then
            begin
              Red   := Round((x/NumOfLines*StartRed   + (NumOfLines-x)/NumOfLines*StopRed  ));
              Green := Round((x/NumOfLines*StartGreen + (NumOfLines-x)/NumOfLines*StopGreen));
              Blue  := Round((x/NumOfLines*StartBlue  + (NumOfLines-x)/NumOfLines*StopBlue ));
            end
          else
            begin
              Red   := Round((x/NumOfLines*StopRed    + (NumOfLines-x)/NumOfLines*StartRed  ));
              Green := Round((x/NumOfLines*StopGreen  + (NumOfLines-x)/NumOfLines*StartGreen));
              Blue  := Round((x/NumOfLines*StopBlue   + (NumOfLines-x)/NumOfLines*StartBlue ));
            end;

          Pen.Color := $02000000 + (Red + Green shl 8 + Blue shl 16);

          if x < (NumOfLines div 2) then
            Polyline([Point(Left+x, Top), Point(Left, Top+x)])
          else
            Polyline([Point(Right, Top + x - NumOfLines div 2), Point(Left+x - NumOfLines div 2, Bottom)])
        end;

      Pen.Color := BackColor;  
      LastX         := - 1;
      CenterPoint.X := (Left + Right ) div 2;
      CenterPoint.Y := (Top  + Bottom) div 2;

      for i := 0 to NumOfLines*2 do
        begin
          X := Round(Cos(DegToRad(90*i/(NumOfLines*2))) * Radius);
          Y := Round(Sin(DegToRad(90*i/(NumOfLines*2))) * Radius);
          if X = LastX then Continue;
          LastX := X;

          Polyline([Point(CenterPoint.X + X, CenterPoint.Y - Y), Point(CenterPoint.X + X, Top-1       )]);
          Polyline([Point(CenterPoint.X - X, CenterPoint.Y - Y), Point(CenterPoint.X - X, Top-1       )]);
          Polyline([Point(CenterPoint.X + X, CenterPoint.Y + Y), Point(CenterPoint.X + X, ARect.Bottom)]);
          Polyline([Point(CenterPoint.X - X, CenterPoint.Y + Y), Point(CenterPoint.X - X, ARect.Bottom)]);
        end;
    end;
end;
//****************************************************************************************************************************************************
function GetXYRadPoint2(AngleDegrees, Radius: Double; OffsetX, OffsetY : Double) : TPoint;
begin
  Result := Point(Trunc(OffsetX + Cos(DegToRad(AngleDegrees))*Radius),Trunc(OffsetY - Sin(DegToRad(AngleDegrees))*Radius));
end;                               
//****************************************************************************************************************************************************
procedure DrawGradientCircle(Canvas: TCanvas; const CenterPoint: TPoint; Radius: Integer; ReverseColors: Boolean);
var
  Red, Green, Blue : Integer;
  StartRed         : Integer;
  StartGreen       : Integer;
  StartBlue        : Integer;
  StopRed          : Integer;
  StopGreen        : Integer;
  StopBlue         : Integer;
  NumOfLines       : Integer;
  KnobRect         : TRect;
  PointRadius      : Double;
  Size             : Double;
  Point1           : TPoint;
  Point2           : TPoint;
  MidX, MidY       : Double;
  PercentComplete  : Double;
begin
  KnobRect := Rect(CenterPoint.X - Radius, CenterPoint.Y - Radius, CenterPoint.X + Radius, CenterPoint.Y + Radius);
  with Canvas, KnobRect do
    begin
      StartRed   := iGetRValue(ColorToRGB(clWhite) and $FFFFFF);
      StartGreen := iGetGValue(ColorToRGB(clWhite) and $FFFFFF);
      StartBlue  := iGetBValue(ColorToRGB(clWhite) and $FFFFFF);

      StopRed    := iGetRValue(ColorToRGB(clBtnFace) and $FFFFFF - $505050);
      StopGreen  := iGetGValue(ColorToRGB(clBtnFace) and $FFFFFF - $505050);
      StopBlue   := iGetBValue(ColorToRGB(clBtnFace) and $FFFFFF - $505050);

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

      NumOfLines := Radius*2;

      if NumOfLines = 0 then exit;
                                            
      MidX := -Trunc(Radius/Sqrt(2)+2);
      MidY :=  Trunc(Radius/Sqrt(2)+2);

      while MidX < Radius/Sqrt(2)+2 do
        begin
          PointRadius := Sqrt(MidX*MidX + MidY*MidY);

          MidX := MidX + 0.5;
          MidY := MidY - 0.5;

          if PointRadius > Radius then Continue;

          Size := Sqrt(Radius*Radius - PointRadius*PointRadius);

          Point1 := GetXYRadPoint2(45 - 90, Size, MidX, MidY);

          Point2 := Point(-Point1.Y, -Point1.X);

          PercentComplete := (MidX + Radius)/Radius/2;

          if ReverseColors then
            begin
              Red   := Round((PercentComplete*StartRed   + (1-PercentComplete)*StopRed  ));
              Green := Round((PercentComplete*StartGreen + (1-PercentComplete)*StopGreen));
              Blue  := Round((PercentComplete*StartBlue  + (1-PercentComplete)*StopBlue ));
            end
          else
            begin
              Red   := Round((PercentComplete*StopRed    + (1-PercentComplete)*StartRed  ));
              Green := Round((PercentComplete*StopGreen  + (1-PercentComplete)*StartGreen));
              Blue  := Round((PercentComplete*StopBlue   + (1-PercentComplete)*StartBlue ));
            end;

          Pen.Color := $02000000 or (Red + (Green shl 8) + (Blue shl 16));
          Polyline([Point(CenterPoint.X + Point1.X - 1, CenterPoint.Y - Point1.Y - 1),
                    Point(CenterPoint.X + Point2.X - 1, CenterPoint.Y - Point2.Y - 1)]);
        end;
    end;
end;
//****************************************************************************************************************************************************
function GetNextRowString(var StringCurrentPos, StringScanPos: PChar; var RowString: String): Boolean;
begin
  if StringScanPos^ <> #0 then
    begin
      Result := True;
      while not (StringScanPos^ in [#0, #13, #10]) do Inc(StringScanPos);

      SetString(RowString, StringCurrentPos, StringScanPos - StringCurrentPos);

      if StringScanPos^ = #13 then Inc(StringScanPos);
      if StringScanPos^ = #10 then Inc(StringScanPos);

      StringCurrentPos := StringScanPos;
    end
  else
    begin
      RowString := '';
      Result    := False;
    end;
end;
//****************************************************************************************************************************************************
function  iTextWidth(Canvas: TCanvas; AText: String): Integer;
var
  StringCurrentPos : PChar;
  StringScanPos    : PChar;
  RowString        : String;
  AWidth           : Integer;
begin
  if AText <> '' then
    begin
      with Canvas do
        begin
          Result           := 0;
          StringCurrentPos := Pointer(AText);
          StringSc