icomponent.pas

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

                  Font.Color := clWhite;
                  iDrawText(FOffScreenBitmap.Canvas, e.Message, ARect, [itfWordBreak]);
              end;
          end;
        end;


        if Assigned(FOnPaint) then FOnPaint(Self, FOffScreenBitmap.Canvas);

        ShowOffScreenBitmap(FOffScreenBitmap);
      finally
        FOffScreenBitmap.Free;
      end;
    finally
      Unlock;
    end;
  except
    on exception do;
  end;
end;
//****************************************************************************************************************************************************
procedure TiComponent.iDoKillFocus;
begin
  try
    FHasFocus := False;
    iMouseUp(mbLeft, [], 0, 0);
    Invalidate;
  except
  end;
end;
//****************************************************************************************************************************************************
procedure TiComponent.iDoSetFocus;
begin
  FHasFocus := True;
  SetParentsToTopMost(Self);
  Invalidate;
end;
//****************************************************************************************************************************************************
procedure TiComponent.KeyUp(var Key: Word; Shift: TShiftState);
begin
  FUserGenerated := True;
  try
    try
      inherited;
      iKeyUp(Key, Shift);
    except
      on exception do;
    end;
  finally
    FUserGenerated := False;
  end;
end;
//****************************************************************************************************************************************************
procedure TiComponent.KeyDown(var Key: Word; Shift: TShiftState);
begin
  FUserGenerated := True;
  try
    try
      inherited;
      iKeyDown(Key, Shift);
    except
      on exception do;
    end;
  finally
    FUserGenerated := False;
  end;
end;
//****************************************************************************************************************************************************
procedure TiComponent.KeyPress(var Key: Char);
begin
  FUserGenerated := True;
  try
    try
      inherited;
      iKeyPress(Key);
    except
      on exception do;
    end;
  finally
    FUserGenerated := False;
  end;
end;
//****************************************************************************************************************************************************
procedure TiComponent.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  FUserGenerated := True;
  try                                        
    iMouseDown(Button, Shift, X, Y);
    inherited MouseDown(Button, Shift, X, Y);
  finally
    FUserGenerated := False;
  end;
end;
//****************************************************************************************************************************************************
procedure TiComponent.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  FUserGenerated := True;
  try
    iMouseMove(Shift, X, Y);
    inherited MouseMove(Shift, X, Y);
  finally
    FUserGenerated := False;
  end;
end;
//****************************************************************************************************************************************************
procedure TiComponent.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  FUserGenerated := True;
  try
    iMouseUp(Button, Shift, X, Y);
    inherited MouseUp(Button, Shift, X, Y);
  finally
    FUserGenerated := False;
  end;
end;
//****************************************************************************************************************************************************
procedure TiComponent.DblClick;
begin
  FUserGenerated := True;
  try
    iDoubleClick;
    inherited DblClick;
  finally
    FUserGenerated := False;
  end;
end;
//****************************************************************************************************************************************************
procedure TiComponent.iWantSpecialKey(var CharCode: Word; var Result: Longint);begin end;
procedure TiComponent.iKeyUp         (var CharCode: Word; Shift: TShiftState); begin end;
procedure TiComponent.iKeyDown       (var CharCode: Word; Shift: TShiftState); begin end;
procedure TiComponent.iKeyPress      (var Key: Char);                          begin end;
//****************************************************************************************************************************************************
procedure TiComponent.iMouseUp    (Button: TMouseButton; Shift: TShiftState; X, Y: Integer         );         begin                 end;
procedure TiComponent.iMouseDown  (Button: TMouseButton; Shift: TShiftState; X, Y: Integer         );         begin                 end;
procedure TiComponent.iMouseMove  (                      Shift: TShiftState; X, Y: Integer         );         begin                 end;
function  TiComponent.iMouseWheel (WheelDelta: Integer;  Shift: TShiftState; const MousePos: TPoint): Boolean;begin Result := False;end;
procedure TiComponent.iDoubleClick;                                                                           begin                 end;
//****************************************************************************************************************************************************
function TiComponent.GetBorderMargin: Integer;
begin
  if FBorderStyle <> ibsNone then Result := 2 else Result := 0;
end;
//****************************************************************************************************************************************************
procedure TiComponent.SaveImageToBitmap(FileName: String);
var
  Bitmap : TBitmap;
begin
  HandleNeeded;
  Bitmap := TBitmap.Create;
  try
    Bitmap.Width  := Width;
    Bitmap.Height := Height;
    iPaintTo(Bitmap.Canvas);

    {$IFDEF EVAL}
    with Bitmap.Canvas do
      begin
        Brush.Color := clBlack;
        Font.Color  := clYellow;
        Font.Style  := [fsBold];
        TextOut(0,0, 'Iocomp Evaluation');
      end;
    {$ENDIF}

    Bitmap.SaveToFile(FileName);
  finally
    Bitmap.Free;
  end;
end;
//****************************************************************************************************************************************************
procedure TiComponent.SetLoading(Value: Boolean);
begin
  FLoading := Value
end;
//****************************************************************************************************************************************************
procedure TiComponent.DoIsDesigning(Sender: TObject; var Designing: Boolean);
begin
  Designing := IsDesigning;
end;
//****************************************************************************************************************************************************
function TiComponent.GetIsDesigning: Boolean;
begin
  Result := (csDesigning in ComponentState);
  if Assigned(FOnGetDesigning) then FOnGetDesigning(Self, Result);
end;
//****************************************************************************************************************************************************
procedure TiComponent.SetCachedDrawing(const Value: Boolean);
begin
  if FCachedDrawing <> Value then
    begin
      FCachedDrawing := Value;
      BackGroundChange;
      if not FCachedDrawing then
        begin
          if Assigned(FBackGroundBitmap) then FBackGroundBitmap.Free;
          FBackGroundBitmap := nil;
        end;
    end;
end;
//****************************************************************************************************************************************************
procedure TiComponent.SavePropertiesToFile(FileName: String);
var
  AList      : TStringList;
  IgnoreList : TStringList;
begin
  try
  AList := TStringList.Create;
  try
    IgnoreList := TStringList.Create;
  try
    IgnoreList.Add('Name');
    if not FOptionSaveAllProperties then
      begin
        IgnoreList.Add('Left');
        IgnoreList.Add('Top');
        IgnoreList.Add('Width');
        IgnoreList.Add('Height');
        IgnoreList.Add('Align');
        IgnoreList.Add('Cursor');
        IgnoreList.Add('ShowHint');
        IgnoreList.Add('Tag');
        IgnoreList.Add('Visible');
        IgnoreList.Add('Enabled');
        IgnoreList.Add('Hint');
        IgnoreList.Add('HelpContext');
      end;

    AList.Add('File Type = ' + Self.ClassName);

    SaveObjectToStringList(Self, '', AList, IgnoreList);

    AList.SaveToFile(FileName);
  finally
    IgnoreList.Free;
  end;
  finally
    AList.Free;
  end;
  except
    on e: Exception do raise Exception.Create('Error Saving Properties - ' + e.message);
  end;
end;
//****************************************************************************************************************************************************
procedure TiComponent.LoadPropertiesFromFile(FileName: String);
var
  AList : TStringList;
begin
  try
  AList := TStringList.Create;
  try
    AList.LoadFromFile(FileName);
    BeginUpdate;
    LoadObjectFromStringList(Self, '', AList);
    EndUpdate;
  finally
    AList.Free;
  end;
  except
    on e: Exception do raise Exception.Create('Error Loading Properties - ' + e.message);
  end;
end;
//****************************************************************************************************************************************************
function TiComponent.OPCOutputData(PropertyName: String; Value: OleVariant): Boolean;
begin
  Result := False;
end;
//****************************************************************************************************************************************************
function TiComponent.GetPropertyType(Instance: TPersistent; Path: String; PropertyName: String): TiTypeKind;
var
  i         : Integer;
  Count     : Integer;
  PropName  : String;
  PropInfo  : PPropInfo;                                                                     
  PropList  : PPropList;
  SubClass  : TObject;
  Found     : Boolean;
begin
  Result := TiTypeKind(tkUnknown);
  Count := GetTypeData(Instance.ClassInfo)^.PropCount;
  if Count > 0 then
  begin
    GetMem(PropList, Count * SizeOf(Pointer));
    try
      GetPropInfos(Instance.ClassInfo, PropList);
      for i := 0 to Count - 1 do
      begin
        PropInfo := PropList^[i];
        if PropInfo <> nil then
          begin
            if Assigned(PropInfo^.SetProc) then
              begin
                if Trim(Path) <> '' then PropName  := Path + '.' + PropInfo.Name
                  else PropName  := PropInfo.Name;

                Found := True;
                if PropInfo^.PropType^.Kind <> tkClass then Found := UpperCase(PropertyName) = UpperCase(PropName);

                if not Found then Continue;

                if PropInfo^.PropType^.Kind <> tkClass then
                  begin
                    Result := TiTypeKind(PropInfo^.PropType^.Kind);
                    Exit;
                  end;

                case PropInfo^.PropType^.Kind of
                  tkClass : begin
                              SubClass := GetObjectProperty(Instance, PropInfo.Name);
                              if SubClass is TPersistent then
                                GetPropertyType(SubClass as TPersistent, PropName, PropertyName);
                            end;
                end;
              end;
          end
        else Break;
      end;
    finally
      FreeMem(PropList, Count * SizeOf(Pointer));
    end;
  end;
end;
//****************************************************************************************************************************************************
procedure TiComponent.PropertyVarType(PropertyName: String; var AVarType: TiTypeKind);
begin
  AVarType := GetPropertyType(Self, '', PropertyName);
end;
//****************************************************************************************************************************************************
end.