aqdockinguithemed.pas

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

    bwPin, bwRotatedPin:
      StyleName := 'Explorerbar';
    else
      StyleName := 'Window';
  end;
  Theme := OpenThemeData(GetDesktopWindow, PWideChar(StyleName));
  if AWidget in [bwPin, bwRotatedPin] then
  begin
    Bitmap := Graphics.TBitmap.Create;
    Bitmap.PixelFormat := pf32bit;
    R := Rect(0, 0, 16, 16);
    Bitmap.Width := R.Right - R.Left;
    Bitmap.Height := R.Bottom - R.Top;
    Hndl := Bitmap.Canvas.Handle;
  end
  else
  begin
    Hndl := ACanvas.Handle;
    Bitmap := nil;
    R := ARect;
  end;

  DrawThemeBackground(Theme, Hndl, TaqCaptionButtonWidgets.GetWidgetCode(AWidget),
    GetButtonState(AState, not (AWidget in [bwPin, bwRotatedPin])){States2[AState]}, R, @R);

  if AWidget in [bwPin, bwRotatedPin] then
  begin
    RotatedBitmap := Graphics.TBitmap.Create;
    RotatedBitmap.PixelFormat := pf32bit;
    RotatedBitmap.Width := 16;
    RotatedBitmap.Height := 16;
    DrawImageEx(Bitmap, RotatedBitmap.Canvas, R, Orientation[AWidget = bwRotatedPin], 0);
    Bitmap.Free;
    Bitmap := Graphics.TBitmap.Create;
    Bitmap.Width := ARect.Right - ARect.Left - 2;
    Bitmap.Height := ARect.Bottom - ARect.Top - 2;
    X := (Bitmap.Width - Min(Bitmap.Width, Bitmap.Height)) div 2;
    StretchBlt(Bitmap.Canvas.Handle, X, 0, Bitmap.Width - 2 *X, Bitmap.Height,
      RotatedBitmap.Canvas.Handle, 0, 0, RotatedBitmap.Width, RotatedBitmap.Height, SRCCOPY);
    Bitmap.PixelFormat := pf24bit;
    Bitmap.Transparent := True;
    Bitmap.TransparentColor := Bitmap.Canvas.Pixels[0, 0];
    ACanvas.Draw(ARect.Left + 1, ARect.Top + 1, Bitmap);
    RotatedBitmap.Free;
    Bitmap.Free;
  end;
  CloseThemeData(Theme);
end;

function TaqThemedUIStyle.GetCaptionButtonImagesClass: TaqCaptionButtonImagesClass;
begin
  Result := TaqFakeCaptionButtonImages;
end;

procedure TaqThemedUIStyle.CheckTheme;
begin
  FThemeAvailable := InitThemeLibrary and IsAppThemed;
end;

procedure TaqThemedUIStyle.DoDrawHiddenTabItem(ACanvas: TCanvas;
  ARect: TRect; const AText: string; AState: TaqTabItemState;
  AOrientation: TaqHideZoneOrientation; APosition: TaqTabItemPosition; ADrawImage, ADrawText: Boolean;
  AImages: TCustomImageList; AImageIndex: Integer);
const
  Parts: array [TaqTabItemPosition] of Integer =
    (TABP_TABITEMLEFTEDGE, TABP_TABITEM, TABP_TABITEMRIGHTEDGE);
  States: array [TaqTabItemState] of Integer =
    (TIS_NORMAL, TIS_HOT, TIS_NORMAL, TIS_DISABLED, TIS_NORMAL);
  Border: array [TaqTabOrientation] of Cardinal =
    (BF_TOP, BF_BOTTOM);
  State2: array [TaqTabItemState] of Cardinal =
    (0, 0, 0, DTT_GRAYED, 0);
  Orientations: array [TaqHideZoneOrientation] of TaqOrientation =
    // hzoLeft, hzoTop, hzoRight, hzoBottom, hzoDefault
    (orLeft, orBottom, orRight, orTop, orLeft);
var
  Theme: HTHEME;
  ContentRect: TRect;
  TopIndent, PartId: Integer;
begin
  if FThemeAvailable then
    Theme := OpenThemeData(0, 'Tab')
  else
    Theme := 0;
  if Theme <> 0 then
  begin
    TopIndent := FMetrics[dumTabPadding] + 1;
    PartId := Parts[APosition];
    if APosition <> tipLast then
      if AOrientation in [hzoTop, hzoBottom] then
        Inc(ARect.Right)
      else
        Inc(ARect.Bottom);
    case AOrientation of
      hzoTop:
        Dec(ARect.Bottom, TopIndent);
      hzoBottom:
        Inc(ARect.Top, TopIndent);
      hzoLeft:
        Dec(ARect.Right, TopIndent);
      hzoRight:
        Inc(ARect.Left, TopIndent);
    end;
    DrawThemeEx(Theme, ACanvas, ARect, PartId, States[AState], Orientations[AOrientation]);
    CloseThemeData(Theme);
    if APosition <> tipLast then
      if AOrientation in [hzoTop, hzoBottom] then
        Dec(ARect.Right)
      else
        Dec(ARect.Bottom);
    GetThemeBackgroundContentRect(Theme, ACanvas.Handle, PartId,
      States[AState], ARect, @ContentRect);
    DoDrawTabItemContent(ACanvas, ContentRect, AText, AState,
      Orientations[AOrientation], ADrawImage, ADrawText, HiddenTabFont,
      ActiveHiddenTabFont, AImages, AImageIndex, False);
  end
  else
    inherited DoDrawHiddenTabItem(ACanvas, ARect, AText, AState,
      AOrientation, APosition, ADrawImage, ADrawText, AImages, AImageIndex);
end;

procedure TaqThemedUIStyle.DoDrawHideZone(ACanvas: TCanvas; ASiteRect,
  ARect: TRect; AOrientation: TaqHideZoneOrientation);
var
  Theme: HTHEME;
const
  Border: array [TaqTabOrientation] of Cardinal =
    (BF_TOP or BF_RIGHT or BF_LEFT, BF_BOTTOM or BF_RIGHT or BF_LEFT);
  Orientations: array [TaqTabOrientation] of TaqThemeOrientation =
    (toTop, toBottom);
begin
  if FThemeAvailable then
    Theme := OpenThemeData(0, 'Tab')
  else
    Theme := 0;
  if Theme <> 0 then
  begin
    DrawThemeBackground(Theme, ACanvas.Handle, TABP_BODY, 0, ARect, @ARect);
    CloseThemeData(Theme);
  end
  else
    inherited DoDrawHideZone(ACanvas, ASiteRect, ARect, AOrientation);
end;

{ TaqCaptionButtonWidgets }

procedure TaqCaptionButtonWidgets.AssignTo(Dest: TPersistent);
var
  Kind: TaqDockButtonKind;
begin
  if Dest is TaqCaptionButtonWidgets then
    with TaqCaptionButtonWidgets(Dest) do
    begin
      BeginUpdate;
      try
        for Kind := Low(TaqDockButtonKind) to High(TaqDockButtonKind) do
          FButtonWidgets[Kind].Assign(Self.FButtonWidgets[Kind]);
        Images := Self.Images;
      finally
        EndUpdate;
      end;
    end
  else
    inherited;
end;

procedure TaqCaptionButtonWidgets.Change;
begin
  if (FUpdateCount = 0) and (FOwner <> nil) then
    FOwner.Change;
end;

constructor TaqCaptionButtonWidgets.Create(AOwner: TComponent);
var
  Kind: TaqDockButtonKind;
begin
  inherited Create(AOwner);
  Assert(AOwner is TaqThemedUIStyle);
  FOwner := TaqThemedUIStyle(AOwner);
  FImageChangeLink := TChangeLink.Create;
  FDrawStyle := idsStretch;

  for Kind := Low(TaqDockButtonKind) to High(TaqDockButtonKind) do
  begin
    FButtonWidgets[Kind] := TaqCaptionButton.CreateEx(Self, Kind);
    FButtonWidgets[Kind].FDefaultPartIndex := DefWidgets[Kind];
  end;
  Reset;
end;

destructor TaqCaptionButtonWidgets.Destroy;
var
  Kind: TaqDockButtonKind;
begin
  Images := nil;
  FImageChangeLink.Free;

  for Kind := Low(TaqDockButtonKind) to High(TaqDockButtonKind) do
    FreeAndNil(FButtonWidgets[Kind]);

  inherited;
end;

function TaqCaptionButtonWidgets.GetButtonWidget(
  ButtonKind: TaqDockButtonKind): TaqCaptionButton;
begin
  Result := FButtonWidgets[ButtonKind];
end;

function TaqCaptionButtonWidgets.GetButtonKindCode(
  ButtonKind: TaqDockButtonKind): Integer;
begin
  Result := GetWidgetCode(FButtonWidgets[ButtonKind].PartIndex);
end;

class function TaqCaptionButtonWidgets.GetWidgetCode(
  ButtonWidget: TaqCaptionButtonWidget): Integer;
begin
  case ButtonWidget of
    bwNone:
      Result := 0;
    bwDropDown:
      Result := CP_DROPDOWNBUTTON;
    bwSysButton..bwMDIHelpButton:
      Result := Integer(ButtonWidget) + 11;
    bwPushButton:
      Result := BP_PUSHBUTTON;
    bwPin, bwRotatedPin:
      Result := EBP_HEADERPIN;
    else
      Result := Integer(ButtonWidget) - Integer(bwSpinUp) + 1;
  end;
end;

procedure TaqCaptionButtonWidgets.Reset;
var
  Kind: TaqDockButtonKind;
begin
  for Kind := Low(TaqDockButtonKind) to High(TaqDockButtonKind) do
    FButtonWidgets[Kind].Reset;
  Change;
end;

procedure TaqCaptionButtonWidgets.SetButtonWidget(
  ButtonKind: TaqDockButtonKind; Value: TaqCaptionButton);
begin
  if Value <> nil then
    FButtonWidgets[ButtonKind].Assign(Value)
  else
    FButtonWidgets[ButtonKind].Reset;
end;

procedure TaqCaptionButtonWidgets.SetImages(const Value: TImageList);
begin
  if Images <> nil then
    Images.UnRegisterChanges(FImageChangeLink);
  if FImages <> Value then
  begin
    FImages := Value;
    if Images <> nil then
    begin
      Images.RegisterChanges(FImageChangeLink);
      Images.FreeNotification(Owner);
    end;
    TaqCustomDefaultUIStyle(Owner).Images := Value;
    Change;
  end;
end;

procedure TaqCaptionButtonWidgets.BeginUpdate;
begin
  Inc(FUpdateCount);
end;

procedure TaqCaptionButtonWidgets.EndUpdate;
begin
  Dec(FUpdateCount);
  if FUpdateCount = 0 then
    Change;
end;

procedure TaqCaptionButtonWidgets.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if Operation = opRemove then
    if AComponent = Images then
      Images := nil;
end;

procedure TaqCaptionButtonWidgets.SetDrawStyle(
  const Value: TaqImageDrawStyle);
begin
  if FDrawStyle <> Value then
  begin
    FDrawStyle := Value;
    TaqCustomDefaultUIStyle(Owner).CaptionButtons.DrawStyle := Value;
    if Images <> nil then
      Change;
  end;
end;

{ TaqCaptionButton }

procedure TaqCaptionButton.AssignTo(Dest: TPersistent);
begin
  if Dest is TaqCaptionButton then
    with TaqCaptionButton(Dest) do
    begin
      Owner.BeginUpdate;
      try
        PartIndex := Self.PartIndex;
        ImageIndex := Self.ImageIndex;
      finally
        Owner.EndUpdate;
      end;
    end
  else
    inherited;
end;

constructor TaqCaptionButton.CreateEx(AOwner: TaqCaptionButtonWidgets;
  Kind: TaqDockButtonKind);
begin
  Assert(AOwner is TaqCaptionButtonWidgets);
  FOwner := AOwner;
  FKind := Kind;
  inherited Create;
  Reset;
end;

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

procedure TaqCaptionButton.Reset;
begin
  FPartIndex := FDefaultPartIndex;
  FImageIndex := -1;
  Owner.Change;
end;

procedure TaqCaptionButton.SetImageIndex(const Value: TImageIndex);
begin
  if FImageIndex <> Value then
  begin
    FImageIndex := Value;
    TaqCustomDefaultUIStyle(Owner.Owner).CaptionButtons[FKind] := Value;
    Owner.Change;
  end;
end;

procedure TaqCaptionButton.SetPartIndex(
  const Value: TaqCaptionButtonWidget);
begin
  if FPartIndex <> Value then
  begin
    FPartIndex := Value;
    Owner.Change;
  end;
end;

end.