aqdockingui.pas.~1~

AutomatedDocking Library 控件源代码修改 适合Delphi 2009 和C++ Builder 20009 使用。 修正汉字不能正确显示问题

procedure TaqDockingUIStyle.SetShowAccelChar(
  const Value: TaqShowAccelChar);
begin
  if FShowAccelChar <> Value then
  begin
    FShowAccelChar := Value;
    Change;
  end;
end;

procedure TaqDockingUIStyle.SetSplitterHeight(const Value: Integer);
begin
  if FSplitterHeight <> Value then
  begin
    FSplitterHeight := Value;
    Change;
  end;
end;

procedure TaqDockingUIStyle.SetSplitterWidth(const Value: Integer);
begin
  if FSplitterWidth <> Value then
  begin
    FSplitterWidth := Value;
    Change;
  end;
end;

procedure TaqDockingUIStyle.SetStyleManager(const Value: TaqStyleManager);
begin
  if FStyleManager <> Value then
  begin
    if FStyleManager <> nil then
      FStyleManager.Items.InternalRemove(Self);
    FStyleManager := Value;
    if FStyleManager <> nil then
      FStyleManager.Items.InternalAdd(Self);
  end;
end;

procedure TaqDockingUIStyle.SetTabFont(const Value: TFont);
begin
  if Value <> nil then
    FTabFont.Assign(Value)
  else
  begin
    FTabFont.Free;
    FTabFont := TFont.Create;
  end;
end;

procedure TaqDockingUIStyle.SetTabIndent(const Value: Integer);
begin
  if FTabIndent <> Value then
  begin
    FTabIndent := Value;
    Change;
  end;
end;

procedure TaqDockingUIStyle.SetUniformTabWidth(const Value: Boolean);
begin
  if FUniformTabWidth <> Value then
  begin
    FUniformTabWidth := Value;
    Change;
  end;
end;

procedure TaqDockingUIStyle.UnRegisterChanges(ALink: TaqStyleChangeLink);
var
  I: Integer;
begin
  if FLinks <> nil then
    for I := 0 to FLinks.Count - 1 do
      if FLinks[I] = ALink then
      begin
        ALink.Sender := nil;
        if ALink.Owner <> nil then
          RemoveFreeNotification(ALink.Owner);
        FLinks.Delete(I);
        Break;
      end;
end;

procedure TaqDockingUIStyle.UpdateCaption(const Value: string);
begin
  if FPredefined then
    FCaption := ''
  else
    FCaption := Value;
  if (FStyleManager <> nil) and (FStyleManager.Items.FStyles[Index] <> GetCaption) then
    FStyleManager.Items.FStyles[Index] := GetCaption;
end;

procedure TaqDockingUIStyle.WriteCaption(Writer: TWriter);
begin
  Writer.WriteString(Caption);
end;

procedure TaqDockingUIStyle.WritePredefined(Writer: TWriter);
begin
  Writer.WriteBoolean(FPredefined);
end;

{ TaqStyleChangeLink }

destructor TaqStyleChangeLink.Destroy;
begin                                                    
  if Sender <> nil then
    TaqDockingUIStyle(Sender).UnRegisterChanges(Self);
  inherited;
end;

function TaqStyleChangeLink.GetSender: TaqDockingUIStyle;
begin
  Result := TaqDockingUIStyle(inherited Sender);
end;

procedure TaqStyleChangeLink.SetSender(const Value: TaqDockingUIStyle);
begin
  inherited Sender := Value;
end;

{ TaqStylesChangeLink }

procedure TaqStylesChangeLink.Change(AStyle: TaqDockingUIStyle);
begin
  if Assigned(FOnChange) then FOnChange(AStyle);
end;

destructor TaqStylesChangeLink.Destroy;
begin
  if Sender <> nil then TaqStyleManager(Sender).UnRegisterChanges(Self);
  inherited;
end;

procedure TaqStylesChangeLink.Register(AStyle: TaqDockingUIStyle);
begin
  if Assigned(FOnRegister) then FOnRegister(AStyle);
end;

procedure TaqStylesChangeLink.UnRegister(AStyle: TaqDockingUIStyle);
begin
  if Assigned(FOnUnRegister) then FOnUnRegister(AStyle);
end;

{ TaqStyles }

function TaqStyles.Add(
  StyleClass: TaqDockingUIStyleClass): TaqDockingUIStyle;
begin
  Result := StyleClass.Create(FOwner);
end;

procedure TaqStyles.AssignTo(Dest: TPersistent);
var
  i: Integer;
begin
  if Dest is TaqStyles then
    with TaqStyles(Dest) do
    begin
      Clear;
      for i := 0 to Self.Count - 1 do
        Clone(Self.Items[i]);
    end
  else if Dest is TStrings then
    with TStrings(Dest) do
    begin
      BeginUpdate;
      try
        Clear;
        for i := 0 to Self.Count - 1 do
          AddObject(Self.FStyles[i], Self.FStyles.Objects[i]);
      finally
        EndUpdate;
      end;
    end
  else
    inherited;
end;

procedure TaqStyles.Clear;
var
  i: Integer;
begin
  for i := FStyles.Count - 1 downto 0 do
    FStyles.Objects[i].Free;
  FStyles.Clear;
end;

function TaqStyles.Clone(AIndex: Integer): Integer;
begin
  with Add(TaqDockingUIStyleClass(Items[AIndex].ClassType)) do
  begin
    Assign(Items[AIndex]);
    Result := Index;
  end;
end;

function TaqStyles.Clone(AStyle: TaqDockingUIStyle): TaqDockingUIStyle;
begin
  Result := Add(TaqDockingUIStyleClass(AStyle.ClassType));
  Result.Assign(AStyle);
end;

constructor TaqStyles.Create(AOwner: TaqStyleManager);
begin
  inherited Create;
  FOwner := AOwner;
  Assert(FOwner <> nil);
  FStyles := TStringList.Create;
  FChangeLink := TaqStyleChangeLink.Create;
  FChangeLink.OnChange := StyleChange;
end;

destructor TaqStyles.Destroy;
begin
  Clear;
  FStyles.Free;
  FChangeLink.Free;
  inherited;
end;

function TaqStyles.Find(AStyle: TaqDockingUIStyle): Integer;
begin
  Result := FStyles.IndexOfObject(AStyle);
end;

function TaqStyles.Find(const AStyleName: TaqStyleName): Integer;
begin
  Result := FStyles.IndexOf(AStyleName);
end;

function TaqStyles.GetCount: Integer;
begin
  Result := FStyles.Count;
end;

function TaqStyles.GetItem(Index: Integer): TaqDockingUIStyle;
begin
  Result := TaqDockingUIStyle(FStyles.Objects[Index]);
end;

function TaqStyles.GetName(Index: Integer): TaqStyleName;
begin
  Result := FStyles[Index];
end;

function TaqStyles.GetOwner: TPersistent;
begin
  Result := FOwner;
end;

function TaqStyles.GetStyleByName(
  const AStyleName: string): TaqDockingUIStyle;
var
  Index: Integer;
begin
  Index := FStyles.IndexOf(AStyleName);
  if Index >= 0 then
    Result := TaqDockingUIStyle(FStyles.Objects[Index])
  else
    Result := nil;
end;

procedure TaqStyles.InternalAdd(AStyle: TaqDockingUIStyle);
var
  NewCaption: TaqStyleName;
begin
  NewCaption := NewStyleName(AStyle);
  FStyles.AddObject(NewCaption, AStyle);

  AStyle.Caption := NewCaption;
  if not (csLoading in FOwner.ComponentState) then
    AStyle.Name := GetValidName(AStyle, Copy(string(AStyle.ClassName), 2, MaxInt), True);

  AStyle.RegisterChanges(FChangeLink);
  FOwner.DoRegisterStyle(AStyle);
  aqIDEDesigner.Modified(Self);
end;

procedure TaqStyles.InternalRemove(AStyle: TaqDockingUIStyle);
begin
  FStyles.Delete(FStyles.IndexOfObject(AStyle));
  AStyle.UnRegisterChanges(FChangeLink);
  FOwner.DoUnregisterStyle(AStyle);
  if aqIDEDesigner <> nil then
    aqIDEDesigner.Modified(Self);
end;

function TaqStyles.NewStyleName(AStyle: TaqDockingUIStyle): string;
var
  i: Integer;
  NewName: string;
begin
  Result := aqDockingUIStyles.Names[TaqDockingUIStyleClass(AStyle.ClassType)];
  if not AStyle.Predefined then
  begin
    for i := 1 to MaxInt do
    begin
      NewName := Result + IntToStr(i);
      if FStyles.IndexOf(NewName) < 0 then
      begin
        Result := NewName;
        Exit;
      end;
    end;
    Assert(False, 'Cannot generate a name for style instance');
  end;
end;

procedure TaqStyles.StyleChange(Sender: TObject);
begin
  FOwner.DoChangeStyle(TaqDockingUIStyle(Sender));
end;

initialization
  FaqDockingUIStyles := TaqClassList.Create;

  Classes.GroupDescendentsWith(TaqDockingUIStyle, TControl);
  Classes.GroupDescendentsWith(TaqStyleManager, TControl);
  Classes.RegisterClasses([TaqDockingUIStyle, TaqStyleManager]);

  with aqDockingUIStyles do
  begin
    RegisterClass(SDefaultStyleName, TaqDefaultUIStyle);
    RegisterClass(SStandardStyleName, TaqStandardUIStyle);
    RegisterClass(SEnhancedStyleName, TaqEnhancedUIStyle);
    RegisterClass(SFlatStyleName, TaqFlatUIStyle);
    RegisterClass(SMSVS2005StyleName, TaqVS2005UIDockingStyle);
{$IFDEF VCL}
    RegisterClass(SThemedStyleName, TaqThemedUIStyle);
    RegisterClass(SOfficeXPStyleName, TaqOfficeXPUIStyle);
{$ELSE}
// todo   RegisterClass(SQtStyleName, TaqQtBasedUIStyle);
{$ENDIF}
  end;

finalization
  with aqDockingUIStyles do
  begin
{$IFDEF VCL}
    UnregisterClass(SThemedStyleName);
    UnregisterClass(SOfficeXPStyleName);
{$ELSE}
// todo    UnregisterClass(SQtStyleName);
{$ENDIF}
    UnregisterClass(SDefaultStyleName);
    UnregisterClass(SStandardStyleName);
    UnregisterClass(SEnhancedStyleName);
    UnregisterClass(SFlatStyleName);
    UnregisterClass(SMSVS2005StyleName);
  end;
  FreeAndNil(FaqDockingUIStyles);
end.