TControl.GetDeviceContext会给图形控件建立新的坐标原点和建立新的剪裁区域

Posted 2020-06-17

这是取得DC句柄的其中一种方法（会重定义原点和建立新的剪裁区）：

function TControl.GetDeviceContext(var WindowHandle: HWnd): HDC;
begin
  if Parent = nil then
    raise EInvalidOperation.CreateFmt(SParentRequired, [Name]);
  Result := Parent.GetDeviceContext(WindowHandle);
  SetViewportOrgEx(Result, Left, Top, nil);       // 注意，根据当前图形控件的坐标建立新的原点
  IntersectClipRect(Result, 0, 0, Width, Height); // 注意，只针对当前图形控件的区域建立新的剪裁区
end;

function TWinControl.GetDeviceContext(var WindowHandle: HWnd): HDC;
begin
  if csDesigning in ComponentState then
    Result := GetDCEx(Handle, 0, DCX_CACHE or DCX_CLIPSIBLINGS)
  else
    Result := GetDC(Handle);
  if Result = 0 then raise EOutOfResources.CreateRes(@SWindowDCError);
  WindowHandle := FHandle;
end;

--------------------- 在两个地方会调用GetDeviceContext函数 -----------------
注意，只有TCanvas.RequiredState会调用TControlCanvas.CreateHandle函数

procedure TControlCanvas.CreateHandle;
begin
  if FControl = nil then inherited CreateHandle else
  begin
    if FDeviceContext = 0 then
    begin
      with CanvasList.LockList do
      try
        if Count >= CanvasListCacheSize then FreeDeviceContext;
        FDeviceContext := FControl.GetDeviceContext(FWindowHandle);
        Add(Self);
      finally
        CanvasList.UnlockList;
      end;
    end;
    Handle := FDeviceContext;
    UpdateTextFlags;
  end;
end;

function TControl.PaletteChanged(Foreground: Boolean): Boolean;
var
  OldPalette, Palette: HPALETTE;
  WindowHandle: HWnd;
  DC: HDC;
begin
  Result := False;
  if not Visible then Exit;
  Palette := GetPalette;
  if Palette <> 0 then
  begin
    DC := GetDeviceContext(WindowHandle);
    OldPalette := SelectPalette(DC, Palette, not Foreground);
    if RealizePalette(DC) <> 0 then Invalidate;
    SelectPalette(DC, OldPalette, True);
    ReleaseDC(WindowHandle, DC);
    Result := True;
  end;
end;

--------------------- 调用调色板变化的5个函数 -----------------

procedure TControl.SetZOrderPosition(Position: Integer);
var
  I, Count: Integer;
  ParentForm: TCustomForm;
begin
  TControl(ParentForm).PaletteChanged(True);
end;

procedure TWinControl.WMPaletteChanged(var Message: TMessage);
begin
  Message.Result := Longint(PaletteChanged(False));
end;

procedure TWinControl.WMSysColorChange(var Message: TWMSysColorChange);
begin
  Graphics.PaletteChanged;
  Perform(CM_SYSCOLORCHANGE, 0, 0);
end;

function TWinControl.PaletteChanged(Foreground: Boolean): Boolean;
var
  I: Integer;
begin
  Result := inherited PaletteChanged(Foreground);
  if Visible then
    for I := ControlCount - 1 downto 0 do
    begin
      if Foreground and Result then Exit;
      Result := Controls[I].PaletteChanged(Foreground) or Result;
    end;
end;

procedure TWinControl.WMQueryNewPalette(var Message: TMessage);
begin
  Include(FControlState, csPalette);
  Message.Result := Longint(PaletteChanged(True));
end;

procedure TWinControl.WMPaletteChanged(var Message: TMessage);
begin
  Message.Result := Longint(PaletteChanged(False));
end;