iobjectcanvas.pas

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

                                    PointArray[Index].X := TruncHalf( (iDrawObject.PolyPoint[Index].x - FOriginX)*ScaleXFactor) + CenterPoint.X;
                                    PointArray[Index].Y := TruncHalf(-(iDrawObject.PolyPoint[Index].y - FOriginY)*ScaleYFactor) + CenterPoint.Y;
                                  end;

                                Polygon(PointArray);

                              finally
                                PointArray := nil;
                              end;
                            end;
          end;
        end;
    end;
    
  {$ifdef iVCL}if not TransParent then DrawBorder(Canvas);{$endif}
  {$ifdef iCLX}                        DrawBorder(Canvas);{$endif}
end;
//*************************************************************************************************************************************
procedure TiObjectCanvas.DrawObjectText(Canvas: TCanvas; iDrawObject: TiDrawObject; CenterPoint: TPoint; ScaleXFactor, ScaleYFactor: Double);
var
  FontStyle       : TFontStyles;
  ATextWidth      : Integer;
  ATextHeight     : Integer;
  TextCenterPoint : TPoint;
begin
  with Canvas do
    begin
      Brush.Color := iDrawObject.BrushColor;
      Brush.Style := iDrawObject.BrushStyle;

      FontStyle := [];
      if iDrawObject.FontBold      then Include(FontStyle, fsBold);
      if iDrawObject.FontItalic    then Include(FontStyle, fsItalic);
      if iDrawObject.FontUnderLine then Include(FontStyle, fsUnderline);
      if iDrawObject.FontStrikeOut then Include(FontStyle, fsStrikeOut);

      Font.Name   := iDrawObject.FontName;
      Font.Color  := iDrawObject.FontColor;
      Font.Size   := iDrawObject.FontSize;
      Font.Style  := FontStyle;

      TextCenterPoint := Point(TruncHalf( (iDrawObject.X  - FOriginX)*ScaleXFactor) + CenterPoint.X,
                               TruncHalf(-(iDrawObject.Y  - FOriginY)*ScaleYFactor) + CenterPoint.Y);

      ATextWidth  := TextWidth (iDrawObject.FontCaption);
      ATextHeight := TextHeight(iDrawObject.FontCaption);
      TextOut(TextCenterPoint.X - ATextWidth div 2,TextCenterPoint.Y - ATextHeight div 2, iDrawObject.FontCaption);
      iDrawObject.DrawRect := Rect(TextCenterPoint.X - ATextWidth div 2, TextCenterPoint.Y - ATextHeight div 2,
                                   TextCenterPoint.X + ATextWidth div 2, TextCenterPoint.Y + ATextHeight div 2); 
    end;
end;
//*************************************************************************************************************************************
procedure TiObjectCanvas.iMouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  i           : Integer;
  ARect       : TRect;
  iDrawObject : TiDrawObject;
begin
  FMouseDown       := True;
  FMouseDownHandle := -1;

  for i := FObjectList.Count - 1 downto 0 do
    begin
      iDrawObject := FObjectList.Objects[i] as TiDrawObject;
      ARect := iDrawObject.DrawRect;
      if PtInRect(ARect, Point(X,Y)) then
        begin
          FMouseDownHandle := StrToInt(FObjectList.Strings[i]);
          Break;
        end;
    end;

  if Assigned(FOnMouseDownDisplay) then FOnMouseDownDisplay(Self, Button, Shift, GetPixelsXToDisplayX(X), GetPixelsYToDisplayY(Y));
end;
//*************************************************************************************************************************************
procedure TiObjectCanvas.iMouseMove(Shift: TShiftState; X, Y: Integer);
begin
  if Assigned(FOnMouseMoveDisplay) then FOnMouseMoveDisplay(Self, Shift, GetPixelsXToDisplayX(X), GetPixelsYToDisplayY(Y));
end;
//*************************************************************************************************************************************
procedure TiObjectCanvas.iMouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  iDrawObject : TiDrawObject;
begin
  FMouseDown := False;

  if Assigned(FOnMouseUpDisplay) then FOnMouseUpDisplay(Self, Button, Shift, GetPixelsXToDisplayX(X), GetPixelsYToDisplayY(Y));

  if FMouseDownHandle <> - 1 then
    begin
      iDrawObject := GetObject(FMouseDownHandle);
      if PtInRect(iDrawObject.DrawRect, Point(X,Y)) then
        begin
          if Assigned(FOnClickObject) then FOnClickObject(Self, FMouseDownHandle);
        end;
    end;
  FMouseDownHandle := -1;
end;
//*************************************************************************************************************************************
procedure TiObjectCanvas.iDoKillFocus;
begin
  inherited;
  FMouseDown       := False;
  FMouseDownHandle := -1;
end;
//*************************************************************************************************************************************
function TiObjectCanvas.GetPixelsXToDisplayX(Value: Integer): Double;
begin
  Result := FDisplayRangeX * (Value/Width) + FOriginX - FDisplayRangeX/2;
end;
//*************************************************************************************************************************************
function TiObjectCanvas.GetPixelsYToDisplayY(Value: Integer): Double;
begin
  Result := FDisplayRangeY * (1 - Value/Height) + FOriginY - FDisplayRangeY/2;
end;
//*************************************************************************************************************************************
function TiObjectCanvas.GetDisplayXToPixelsX(Value: Double): Integer;
begin
  if FDisplayRangeX <> 0 then
    Result := Trunc((2*Width*Value - 2*Width*FOriginX + FDisplayRangeX*Width)/(2*FDisplayRangeX))
  else
    Result := 0;
end;
//*************************************************************************************************************************************
function TiObjectCanvas.GetDisplayYToPixelsY(Value: Double): Integer;
begin
  if FDisplayRangeY <> 0 then
    Result := Trunc((2*Height*FDisplayRangeY + 2*Height*FOriginY - Height*FDisplayRangeY - 2*Height*Value)/(2*FDisplayRangeY))
  else
    Result := 0;
end;
//*************************************************************************************************************************************
function TiObjectCanvas.GetImageListCount : Integer;begin Result := FImageList.Count; end;
function TiObjectCanvas.GetImageListHeight: Integer;begin Result := FImageList.Height;end;
function TiObjectCanvas.GetImageListWidth : Integer;begin Result := FImageList.Width; end;
//*************************************************************************************************************************************
procedure TiObjectCanvas.SetImageListHeight(const Value: Integer);begin FImageList.Height := Value;end;
procedure TiObjectCanvas.SetImageListWidth (const Value: Integer);begin FImageList.Width  := Value;end;
//*************************************************************************************************************************************
procedure TiObjectCanvas.ImageListDelete(Index: Integer);
begin
  FImageList.Delete(Index);
end;
//*************************************************************************************************************************************
procedure TiObjectCanvas.ImageListRemoveAll;
begin
  while FImageList.Count > 0 do
    FImageList.Delete(0);
end;
//*************************************************************************************************************************************
procedure TiObjectCanvas.ImageListAdd(Bitmap: TBitmap);
begin
  FImageList.InsertMasked(FImageList.Count, Bitmap, Bitmap.TransparentColor);
end;
//*************************************************************************************************************************************
procedure TiObjectCanvas.SetImageList(ImageList: TImageList);
begin
  if Assigned(ImageList) then
    begin
      if Assigned(FImageList) then FImageList.Free;
      FImageList := ImageList;
    end;
end;
//*************************************************************************************************************************************
procedure TiObjectCanvas.DefineProperties(Filer: TFiler);
begin
  Filer.DefineBinaryProperty('ImageList', ReadImageList, WriteImageList, FImageList.Count <> 0);
  inherited;
end;
//*************************************************************************************************************************************
procedure TiObjectCanvas.ImageListLoadFromBitmap(ABitmap: TBitmap);
var
  BBitmap    : TBitmap;
  OffsetX    : Integer;
  OffsetY    : Integer;
  AImageList : TImageList;
begin
  AImageList := FImageList;

  if AImageList.Count = 0 then
    begin
      AImageList.Width  := ABitmap.Width;
      AImageList.Height := ABitmap.Height;
    end
  else if (ABitmap.Width < AImageList.Width) and (ABitmap.Height < AImageList.Height) then
    begin
      BBitmap := TBitmap.Create;
      try
        BBitmap.Width  := AImageList.Width;
        BBitmap.Height := AImageList.Height;

        BBitmap.Canvas.Brush.Style := bsSolid;
        BBitmap.Canvas.Brush.Color := ABitmap.TransparentColor;
        BBitmap.Canvas.FillRect(Rect(0, 0, BBitmap.Width, BBitmap.Height));

        OffsetX := BBitmap.Width  div 2 - ABitmap.Width  div 2;
        OffsetY := BBitmap.Height div 2 - ABitmap.Height div 2;

        BBitmap.Canvas.Draw(OffsetX, OffsetY, ABitmap);

        ABitmap.Assign(BBitmap);
      finally
        BBitmap.Free;
      end;
    end
  else if (ABitmap.Width > AImageList.Width) and (ABitmap.Height > AImageList.Height) then
    begin

    end
  else if (ABitmap.Width <> AImageList.Width) and (ABitmap.Height <> AImageList.Height) then
    raise Exception.Create('Image Width and Height must be the same as other images, or both smaller, or both larger');

  AImageList.InsertMasked(AImageList.Count, ABitmap, ABitmap.TransparentColor);

  InvalidateChange;
end;
//*************************************************************************************************************************************
procedure TiObjectCanvas.ImageListLoadFromResourceID(Instance: Cardinal; ResID: Integer);
var
  ABitmap : TBitmap;
begin
  ABitmap := TBitmap.Create;
  try
    ABitmap.LoadFromResourceID(Instance, ResID);
    ImageListLoadFromBitmap(ABitmap);
  finally
    ABitmap.Free;
  end;
end;
//*************************************************************************************************************************************
procedure TiObjectCanvas.ImageListLoadFromResourceName(Instance: Cardinal; ResName: String);
var
  ABitmap : TBitmap;
begin
  ABitmap := TBitmap.Create;
  try
    ABitmap.LoadFromResourceName(Instance, ResName);

    ImageListLoadFromBitmap(ABitmap);
  finally
    ABitmap.Free;
  end;
end;
//*************************************************************************************************************************************
procedure TiObjectCanvas.ReadImageList(Stream: TStream);
{$IFDEF iVCL}
var
  SA: TStreamAdapter;
{$ENDIF}
begin
 {$IFDEF iVCL}
  FImageList.Clear;
  SA := TStreamAdapter.Create(Stream);
  try
    FImageList.Handle := ImageList_Read(SA);
    if FImageList.Handle = 0 then raise EReadError.Create('Failed to read ImageList data from stream');
  finally
    SA.Free;
  end;
 {$ENDIF}
 {$IFDEF iCLX}
 FImageList.ReadData(Stream);
 {$ENDIF}
end;
//*************************************************************************************************************************************
procedure TiObjectCanvas.WriteImageList(Stream: TStream);
{$IFDEF iVCL}
var
  SA: TStreamAdapter;
{$ENDIF}
begin
 {$IFDEF iVCL}
  SA := TStreamAdapter.Create(Stream);
  try
    if not ImageList_Write(FImageList.Handle, SA) then raise EWriteError.Create('Failed to write ImageList data to stream');
  finally
    SA.Free;
  end;
 {$ENDIF}
 {$IFDEF iCLX}
 FImageList.WriteData(Stream);
 {$ENDIF}
end;
//*************************************************************************************************************************************
end.