thememgr.pas

Last change: 2008-02-03 This is the source code of KCeasy。

    NumGlyphs := TBitBtn(Control).NumGlyphs;
    Caption := TBitBtn(Control).Caption;
  end
  else
  begin
    Layout := TSpeedButton(Control).Layout;
    Spacing := TSpeedButton(Control).Spacing;
    Margin := TSpeedButton(Control).Margin;
    Glyph := TSpeedButton(Control).Glyph;
    NumGlyphs := TSpeedButton(Control).NumGlyphs;
    Caption := TSpeedButton(Control).Caption;
  end;
    
  if (BiDiFlags and DT_RIGHT) = DT_RIGHT then
    if Layout = blGlyphLeft then
      Layout := blGlyphRight
    else
      if Layout = blGlyphRight then
        Layout := blGlyphLeft;

  // Calculate the item sizes.
  ClientSize := Point(Client.Right - Client.Left, Client.Bottom - Client.Top);

  if Assigned(Glyph) then
    GlyphSize := Point(Glyph.Width div NumGlyphs, Glyph.Height)
  else
    GlyphSize := Point(0, 0);
    
  if Length(Caption) > 0 then
  begin
    TextBounds := Rect(0, 0, Client.Right - Client.Left, 0);
    Windows.DrawText(DC, PChar(Caption), Length(Caption), TextBounds, DT_CALCRECT or BiDiFlags);
    TextSize := Point(TextBounds.Right - TextBounds.Left, TextBounds.Bottom - TextBounds.Top);
  end
  else
  begin
    TextBounds := Rect(0, 0, 0, 0);
    TextSize := Point(0,0);
  end;

  // If the layout has the glyph on the right or the left, then both the text and the glyph are centered vertically.
  // If the glyph is on the top or the bottom, then both the text and the glyph are centered horizontally.
  if Layout in [blGlyphLeft, blGlyphRight] then
  begin
    GlyphPos.Y := (ClientSize.Y - GlyphSize.Y + 1) div 2;
    TextPos.Y := (ClientSize.Y - TextSize.Y + 1) div 2;
  end
  else
  begin
    GlyphPos.X := (ClientSize.X - GlyphSize.X + 1) div 2;
    TextPos.X := (ClientSize.X - TextSize.X + 1) div 2;
  end;
    
  // If there is no text or no bitmap, then Spacing is irrelevant.
  if (TextSize.X = 0) or (GlyphSize.X = 0) then
    Spacing := 0;

  // Adjust Margin and Spacing.
  if Margin = -1 then
  begin
    if Spacing = -1 then
    begin
      TotalSize := Point(GlyphSize.X + TextSize.X, GlyphSize.Y + TextSize.Y);
      if Layout in [blGlyphLeft, blGlyphRight] then
        Margin := (ClientSize.X - TotalSize.X) div 3
      else
        Margin := (ClientSize.Y - TotalSize.Y) div 3;
      Spacing := Margin;
    end
    else
    begin
      TotalSize := Point(GlyphSize.X + Spacing + TextSize.X, GlyphSize.Y + Spacing + TextSize.Y);
      if Layout in [blGlyphLeft, blGlyphRight] then
        Margin := (ClientSize.X - TotalSize.X + 1) div 2
      else
        Margin := (ClientSize.Y - TotalSize.Y + 1) div 2;
    end;
  end
  else
  begin
    if Spacing = -1 then
    begin
      TotalSize := Point(ClientSize.X - (Margin + GlyphSize.X), ClientSize.Y - (Margin + GlyphSize.Y));
      if Layout in [blGlyphLeft, blGlyphRight] then
        Spacing := (TotalSize.X - TextSize.X) div 2
      else
        Spacing := (TotalSize.Y - TextSize.Y) div 2;
    end;
  end;
    
  case Layout of
    blGlyphLeft:
      begin
        GlyphPos.X := Margin;
        TextPos.X := GlyphPos.X + GlyphSize.X + Spacing;
      end;
    blGlyphRight:
      begin
        GlyphPos.X := ClientSize.X - Margin - GlyphSize.X;
        TextPos.X := GlyphPos.X - Spacing - TextSize.X;
      end;
    blGlyphTop:
      begin
        GlyphPos.Y := Margin;
        TextPos.Y := GlyphPos.Y + GlyphSize.Y + Spacing;
      end;
    blGlyphBottom:
      begin
        GlyphPos.Y := ClientSize.Y - Margin - GlyphSize.Y;
        TextPos.Y := GlyphPos.Y - Spacing - TextSize.Y;
      end;
  end;

  // Fixup the result variables.
  with GlyphPos do
  begin
    Inc(X, Client.Left + Offset.X);
    Inc(Y, Client.Top + Offset.Y);
  end;
  OffsetRect(TextBounds, TextPos.X + Client.Left + Offset.X, TextPos.Y + Client.Top + Offset.X);
end;

//----------------- TWindowProcList ------------------------------------------------------------------------------------

// For fixing various things in the VCL we have to subclass some of the VCL controls. For each class of control
// one instance of the TWindowProcList is used.

constructor TWindowProcList.Create(Owner: TThemeManager; WindowProc: TWndMethod; ControlClass: TControlClass);

begin
  inherited Create;

  FOwner := Owner;
  FNewWindowProc := WindowProc;
  FControlClass := ControlClass;
end;

//----------------------------------------------------------------------------------------------------------------------

destructor TWindowProcList.Destroy;

begin
  Clear;
  inherited;
end;

//----------------------------------------------------------------------------------------------------------------------

function Compare(Item1, Item2: Pointer): Integer;

// Helper function for sort and find in window proc lists. They are sorted by control reference.

begin
  Result := Integer(PWindowProcEntry(Item1).Control) - Integer(PWindowProcEntry(Item2).Control);
end;

//----------------------------------------------------------------------------------------------------------------------

function TWindowProcList.Add(Control: TControl): Integer;

var
  I: Integer;
  Entry: PWindowProcEntry;
  ControlWndProc: TWndMethod;

begin
  Result := -1;

  if (Control is FControlClass) and not Find(Control, I) then
  begin
    {$ifdef Debug}
      Lock.Enter;
      try
        Inc(SubclassCount);
      finally
        Lock.Leave;
      end;
    {$endif Debug}

    New(Entry);
    Entry.Control := Control;
    Entry.OldWndProc := Control.WindowProc;

    // The following two lines make sure we get the original control, to which a message is sent, in our
    // proxy window procedures. This works because the Data member of the window proc does not get the reference to
    // the theme manager (as it would happen with ControlWindowProc := FNewWindowProc) but instead we explicitly
    // set the control's reference there (see also first proxy method implementation below).
    TMethod(ControlWndProc).Code := TMethod(FNewWindowProc).Code;
    TMethod(ControlWndProc).Data := Control;
    Control.WindowProc := ControlWndProc;

    Result := inherited Add(Entry);
    FDirty := True;
  end;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TWindowProcList.Clear;

begin
  while Count > 0 do
    Remove(PWindowProcEntry(Items[0]).Control);
  inherited;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TWindowProcList.DispatchMessage(Control: TControl; var Message: TMessage);

var
  I: Integer;
  Entry: PWindowProcEntry;

begin
  if Find(Control, I) then
  begin
    // If a window handle is being recreated then we must ensure the handle is really recreated not only destroyed
    // (this might happen when a hidden window's handle is recreated). Otherwise we will not get notified again about
    // the window's real destruction.
    if Message.Msg = CM_RECREATEWND then
      MainManager.AddRecreationCandidate(Control);

    Entry := Items[I];
    Entry.OldWndProc(Message);

    // If a control is being destroyed then we have to revert the subclassing.
    // We don't get any other opportunity to clean up since TComponent.Notification comes too late and is also not
    // called for controls, which are implicitely freed because their parent is freed.
    if Message.Msg = WM_DESTROY then
    begin
      // Remove any control, which is permanently destroyed, but take care for window recreations.
      if (csDestroying in Control.ComponentState) or not (MainManager.IsRecreationCandidate(Control)) then
        // This call will also remove any child subclassing.
        Remove(Control);
    end;
  end;
end;

//----------------------------------------------------------------------------------------------------------------------

function TWindowProcList.Find(Control: TControl; out Index: Integer): Boolean;

// Binary search implementation to quickly find a control in the list.

var
  L, H,
  I, C: Integer;
  Dummy: TWindowProcEntry;

begin
  // First try the cached data to speed up retrieval.
  if Control = FLastControl then
  begin
    Result := True;
    Index := FLastIndex;
  end
  else
  begin
    if FDirty and (Count > 1) then
    begin
      Sort(Compare);
      FDirty := False;
    end;

    Result := False;
    Dummy.Control := Control;
    L := 0;
    H := Count - 1;
    while L <= H do
    begin
      I := (L + H) shr 1;
      C := Compare(Items[I], @Dummy);
      if C < 0 then
        L := I + 1
      else
      begin
        H := I - 1;
        if C = 0 then
        begin
          Result := True;
          L := I;
        end;
      end;
    end;
    Index := L;
    if Result then
    begin
      FLastControl := Control;
      FLastIndex := L;
    end;
  end;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TWindowProcList.Remove(Control: TControl);

var
  I: Integer;
  Entry: PWindowProcEntry;

begin
  if Find(Control, I) then
  begin
    Entry := Items[I];
    Delete(I);
    Entry.Control.WindowProc := Entry.OldWndProc;

    // Implicitly release all child subclassing.
    if Entry.Control is TWinControl then
      FOwner.RemoveChildSubclassing(Entry.Control as TWinControl);

    Dispose(Entry);

    {$ifdef Debug}
      Lock.Enter;
      try
        Dec(SubclassCount);
      finally
        Lock.Leave;                                   
      end;
    {$endif Debug}
  end;

  if I <= FLastIndex then
  begin
    FLastControl := nil;
    FLastIndex := -1;
  end;

  MainManager.RemoveRecreationCandidate(Control);
end;

//----------------- TThemeManager --------------------------------------------------------------------------------------

constructor TThemeManager.Create(AOwner: TComponent);

begin
  inherited;

  FListeners := TList.Create;
  FOptions := DefaultThemeOptions;

  FPendingFormsList := TList.Create;
  FPendingRecreationList := TList.Create;
  FListViewList := TWindowProcList.Create(Self, PreListviewWindowProc, TCustomListView);
  FTabSheetList := TWindowProcList.Create(Self, PreTabSheetWindowProc, TTabSheet);
  FGroupBoxList := TWindowProcList.Create(Self, PreGroupBoxWindowProc, TCustomGroupBox);
  FButtonControlList := TWindowProcList.Create(Self, PreButtonControlWindowProc, TButtonControl);
  FSpeedButtonList := TWindowProcList.Create(Self, PreSpeedButtonWindowProc, TSpeedButton);
  FSplitterList := TWindowProcList.Create(Self, PreSplitterWindowProc, TSplitter);
  FTrackBarList := TWindowProcList.Create(Self, PreTrackBarWindowProc, TTrackBar);
  FAnimateList := TWindowProcList.Create(Self, PreAnimateWindowProc, TAnimate);
  FStatusBarList := TWindowProcList.Create(Self, PreStatusBarWindowProc, TCustomStatusBar);
  {$ifdef CheckListSupport}
    FCheckListBoxList := TWindowProcList.Create(Self, PreCheckListBoxWindowProc, TCheckListBox);
  {$endif CheckListSupport}
  FFormList := TWindowProcList.Create(Self, PreFormWindowProc, TCustomForm);
  {$ifdef COMPILER_5_UP}
    FFrameList := TWindowProcList.Create(Self, PreFrameWindowProc, TCustomFrame);
  {$endif COMPILER_5_UP}