jvqdyncontrolengine.pas

East make Tray Icon in delphi

      Supports(AControlClass, IJvDynControlData)
  else
  if (ADynControlType = jctEdit) or
    (ADynControlType = jctCalculateEdit) or
    (ADynControlType = jctSpinEdit) or
    (ADynControlType = jctFileNameEdit) or
    (ADynControlType = jctDirectoryEdit) or
    (ADynControlType = jctCheckBox) or
    (ADynControlType = jctDateTimeEdit) or
    (ADynControlType = jctDateEdit) or
    (ADynControlType = jctTimeEdit) then
    Valid := Valid and Supports(AControlClass, IJvDynControlData);
  Result := Valid;
end;

procedure TJvCustomDynControlEngine.RegisterControlType(const ADynControlType: TJvDynControlType;
  AControlClass: TControlClass);
var
  Ind: Integer;
  ControlClassObject: TJvControlClassObject;
begin
  NeedRegisterControls;
  Ind := FRegisteredControlTypes.IndexOf(ADynControlType);
  if Ind >= 0 then
  begin
    ControlClassObject := TJvControlClassObject(FRegisteredControlTypes.Objects[Ind]);
    if Assigned(ControlClassObject) then
      ControlClassObject.Free;
    FRegisteredControlTypes.Delete(Ind);
  end;
  if IsControlTypeValid(ADynControlType, AControlClass) then
  begin
    ControlClassObject := TJvControlClassObject.Create;
    ControlClassObject.ControlClass := AControlClass;
    FRegisteredControlTypes.AddObject(ADynControlType, ControlClassObject);
  end
  else
    raise EJVCLException.CreateResFmt(@RsEUnsupportedControlClass, [ADynControlType]);
end;

function TJvCustomDynControlEngine.GetPropCount(Instance: TPersistent): Integer;
var
  Data: PTypeData;
begin
  Data := GetTypeData(Instance.ClassInfo);
  Result := Data^.PropCount;
end;

function TJvCustomDynControlEngine.GetPropName(Instance: TPersistent; Index: Integer): string;
var
  PropList: PPropList;
  PropInfo: PPropInfo;
  Data: PTypeData;
begin
  Result := '';
  Data := GetTypeData(Instance.ClassInfo);
  GetMem(PropList, Data^.PropCount * SizeOf(PPropInfo));
  try
    GetPropInfos(Instance.ClassInfo, PropList);
    PropInfo := PropList^[Index];
    Result := PropInfo^.Name;
  finally
    FreeMem(PropList, Data^.PropCount * SizeOf(PPropInfo));
  end;
end;

procedure TJvCustomDynControlEngine.SetPropertyValue(const APersistent: TPersistent;
  const APropertyName: string; const AValue: Variant);
var
  Index: Integer;
  PropName: string;
  SubObj: TObject;
  P: Integer;
  SearchName: string;
  LastName: string;
begin
  SearchName := Trim(APropertyName);
  P := Pos('.', SearchName);
  if P > 0 then
  begin
    LastName := Trim(Copy(SearchName, P + 1, Length(SearchName) - P));
    SearchName := Trim(Copy(SearchName, 1, P - 1));
  end
  else
    LastName := '';
  for Index := 0 to GetPropCount(APersistent) - 1 do
  begin
    PropName := UpperCase(GetPropName(APersistent, Index));
    if UpperCase(SearchName) = PropName then
      case PropType(APersistent, PropName) of
        tkLString, tkWString, tkString:
          SetStrProp(APersistent, PropName, VarToStr(AValue));
        tkEnumeration, tkSet, tkChar, tkInteger:
          SetOrdProp(APersistent, PropName, AValue);
//        tkInt64:
//          SetInt64Prop(APersistent, PropName, AValue);
        tkFloat:
          SetFloatProp(APersistent, PropName, AValue);
        tkClass:
          begin
            SubObj := GetObjectProp(APersistent, PropName);
            if SubObj is TStrings then
              TStrings(SubObj).Text := AValue
            else
            if (SubObj is TPersistent) and (LastName <> '') then
              SetPropertyValue(TPersistent(SubObj), LastName, AValue);
          end;
      end;
  end;
end;

function TJvCustomDynControlEngine.GetPropertyValue(const APersistent: TPersistent;
  const APropertyName: string): Variant;
var
  Index: Integer;
  PropName: string;
  SubObj: TObject;
  P: Integer;
  SearchName: string;
  LastName: string;
begin
  SearchName := Trim(APropertyName);
  P := Pos('.', SearchName);
  if P > 0 then
  begin
    LastName := Trim(Copy(SearchName, P + 1, Length(SearchName) - P));
    SearchName := Trim(Copy(SearchName, 1, P - 1));
  end
  else
    LastName := '';
  for Index := 0 to GetPropCount(APersistent) - 1 do
  begin
    PropName := UpperCase(GetPropName(APersistent, Index));
    if UpperCase(SearchName) = PropName then
      case PropType(APersistent, PropName) of
        tkLString, tkWString, tkString:
          Result := GetStrProp(APersistent, PropName);
        tkEnumeration, tkSet, tkChar, tkInteger:
          Result := GetOrdProp(APersistent, PropName);
        tkInt64: 
          Result := GetInt64Prop(APersistent, PropName); 
        tkFloat:
          Result := GetFloatProp(APersistent, PropName);
        tkClass:
          begin
            SubObj := GetObjectProp(APersistent, PropName);
            if SubObj is TStrings then
              Result := TStrings(SubObj).Text
            else
            if (SubObj is TPersistent) and (LastName <> '') then
              Result := GetPropertyValue(TPersistent(SubObj), LastName);
          end;
      end;
  end;
end;

procedure TJvCustomDynControlEngine.AfterCreateControl(AControl: TControl);
begin
  if Assigned(FAfterCreateControl) then
    FAfterCreateControl(AControl);
end;

function TJvCustomDynControlEngine.GetRegisteredControlClass(AControlType: TJvDynControlType): TControlClass;
var
  Ind: Integer;
begin
  NeedRegisterControls;
  Result := nil;
  Ind := FRegisteredControlTypes.IndexOf(AControlType);
  if Ind >= 0 then
    if Assigned(FRegisteredControlTypes.Objects[Ind]) and
      (FRegisteredControlTypes.Objects[Ind] is TJvControlClassObject) then
      Result := TJvControlClassObject(FRegisteredControlTypes.Objects[Ind]).ControlClass;
end;

function TJvCustomDynControlEngine.CreateControl(AControlType: TJvDynControlType;
  AOwner: TComponent; AParentControl: TWinControl; AControlName: string): TControl;
begin
  NeedRegisterControls;
  if Assigned(GetRegisteredControlClass(AControlType)) then
    Result := CreateControlClass(GetRegisteredControlClass(AControlType), AOwner,
      AParentControl, AControlName)
  else
  if AControlType = jctForm then
  begin
    Result := TControl(TForm.Create(AOwner));
    if AControlName <> '' then
      Result.Name := AControlName;
  end
  else
    Result := nil;
  if Result = nil then
    raise EJVCLException.CreateResFmt(@RsENoRegisteredControlClass, [AControlType]);
  AfterCreateControl(Result);
end;

function TJvCustomDynControlEngine.CreateControlClass(AControlClass: TControlClass;
  AOwner: TComponent; AParentControl: TWinControl; AControlName: string): TControl;
var
  DynCtrl: IJvDynControl;
begin
  Result := TControl(AControlClass.Create(AOwner));
  if not Supports(Result, IJvDynControl, DynCtrl) then
    raise EIntfCastError.CreateRes(@RsEIntfCastError);
  DynCtrl.ControlSetDefaultProperties;
  if Assigned(AParentControl) then
    Result.Parent := AParentControl;
  if AControlName <> '' then
    Result.Name := AControlName;
end;

procedure TJvCustomDynControlEngine.SetControlCaption(AControl: IJvDynControl; const Value: string);
begin
end;

procedure TJvCustomDynControlEngine.SetControlTabOrder(AControl: IJvDynControl; Value: Integer);
begin
end;

procedure TJvCustomDynControlEngine.SetControlOnEnter(AControl: IJvDynControl; Value: TNotifyEvent);
begin
end;

procedure TJvCustomDynControlEngine.SetControlOnExit(AControl: IJvDynControl; Value: TNotifyEvent);
begin
end;

procedure TJvCustomDynControlEngine.SetControlOnClick(AControl: IJvDynControl; Value: TNotifyEvent);
begin
end;

procedure TJvCustomDynControlEngine.NeedRegisterControls;
begin
  if not FRegisterControlsExecuted then
  begin
    FRegisterControlsExecuted := True;
    RegisterControls;
  end;
end;

procedure TJvCustomDynControlEngine.RegisterControls;
begin
  // no registration
end;

//=== { TJvDynControlEngine } ================================================

constructor TJvDynControlEngine.Create;
begin
  inherited Create;
  FDistanceBetweenLabelAndControlHorz:= 4;
  FDistanceBetweenLabelAndControlVert:= 1;
end;

function TJvDynControlEngine.CreateLabelControl(AOwner: TComponent;
  AParentControl: TWinControl; const AControlName, ACaption: string;
  AFocusControl: TWinControl): TControl;
var
  DynCtrl: IJvDynControl;
  DynCtrlLabel: IJvDynControlLabel;
begin
  Result := CreateControl(jctLabel, AOwner, AParentControl, AControlName);
  if not Supports(Result, IJvDynControl, DynCtrl) then
    raise EIntfCastError.CreateRes(@RsEIntfCastError);
  DynCtrl.ControlSetCaption(ACaption);
  if not Supports(Result, IJvDynControlLabel, DynCtrlLabel) then
    raise EIntfCastError.CreateRes(@RsEIntfCastError);
  DynCtrlLabel.ControlSetFocusControl(AFocusControl);
end;

function TJvDynControlEngine.CreateStaticTextControl(AOwner: TComponent;
  AParentControl: TWinControl; const AControlName, ACaption: string): TWinControl;
var
  DynCtrl: IJvDynControl;
begin
  Result := TWinControl(CreateControl(jctStaticText, AOwner, AParentControl, AControlName));
  if not Supports(Result, IJvDynControl, DynCtrl) then
    raise EIntfCastError.CreateRes(@RsEIntfCastError);
  DynCtrl.ControlSetCaption(ACaption);