rvcolorcombo.pas

richviewaction 1.58 需要richview 1.9.46

procedure TRVColorCombo.WMThemeChanged(var Msg: TMessage);
begin
  inherited;
  FreeThemeHandle;
  CreateThemeHandle;
  SetWindowPos(Handle, 0, 0, 0, 0, 0, SWP_FRAMECHANGED or SWP_NOMOVE or SWP_NOSIZE or SWP_NOZORDER);
  RedrawWindow(Handle, nil, 0, RDW_FRAME or RDW_INVALIDATE or RDW_ERASE);
  Msg.Result := 1;
end;


procedure TRVColorCombo.SetUseXPThemes(const Value: Boolean);
begin
  if FUseXPThemes<>Value then begin
    FUseXPThemes := Value;
    if HandleAllocated then begin
      FreeThemeHandle;
      CreateThemeHandle;
      SetWindowPos(Handle, 0, 0, 0, 0, 0, SWP_FRAMECHANGED or SWP_NOMOVE or SWP_NOSIZE or SWP_NOZORDER);
      RedrawWindow(Handle, nil, 0, RDW_FRAME or RDW_INVALIDATE or RDW_ERASE);
    end;
  end;
end;

procedure TRVColorCombo.WMNCPaint(var Msg: TMessage);
var
  DC: HDC;
  RC, RW: TRect;
  {$IFDEF USERVKSDEVTE}
  Canvas: TCanvas;
  {$ENDIF}
begin
  {$IFDEF USERVKSDEVTE}
  if IsThemeAvailable(CurrentTheme) and CurrentTheme.IsEditDefined(kescComboBox) then
  begin
    DC := GetWindowDC(Handle);
    try
      Windows.GetClientRect(Handle, RC);
      if GetWindowLong(Handle, GWL_STYLE) and WS_VSCROLL <> 0 then
        if (GetWindowLong(Handle, GWL_EXSTYLE) and WS_EX_LEFTSCROLLBAR)<>0 then
          dec(RC.Left, GetSystemMetrics(SM_CXVSCROLL))
        else
          inc(RC.Right, GetSystemMetrics(SM_CXVSCROLL));
      if GetWindowLong(Handle, GWL_STYLE) and WS_HSCROLL <> 0 then
        inc(RC.Bottom, GetSystemMetrics(SM_CYHSCROLL));
      GetWindowRect(Handle, RW);
      MapWindowPoints(0, Handle, RW, 2);
      OffsetRect(RC, -RW.Left, -RW.Top);
      ExcludeClipRect(DC, RC.Left, RC.Top, RC.Right, RC.Bottom);
      OffsetRect(RW, -RW.Left, -RW.Top);

      Canvas := TCanvas.Create;
      try
        Canvas.Handle := DC;
        CurrentTheme.EditDraw(kescComboBox, Canvas, EditInfo(RW, kedsNormal));
      finally
        Canvas.Handle := 0;
        Canvas.Free;
      end;

      Msg.Result := 0;
    finally
      ReleaseDC(Handle, DC);
    end;
    Exit;
  end;
  {$ENDIF}
  if FThemeEdit=0 then
  begin
    inherited;
    exit;
  end;
  DC := GetWindowDC(Handle);
  try
    Windows.GetClientRect(Handle, RC);
    if GetWindowLong(Handle, GWL_STYLE) and WS_VSCROLL <> 0 then
      if (GetWindowLong(Handle, GWL_EXSTYLE) and WS_EX_LEFTSCROLLBAR)<>0 then
        dec(RC.Left, GetSystemMetrics(SM_CXVSCROLL))
      else
        inc(RC.Right, GetSystemMetrics(SM_CXVSCROLL));
    if GetWindowLong(Handle, GWL_STYLE) and WS_HSCROLL <> 0 then
      inc(RC.Bottom, GetSystemMetrics(SM_CYHSCROLL));
    GetWindowRect(Handle, RW);
    MapWindowPoints(0, Handle, RW, 2);
    OffsetRect(RC, -RW.Left, -RW.Top);
    ExcludeClipRect(DC, RC.Left, RC.Top, RC.Right, RC.Bottom);
    OffsetRect(RW, -RW.Left, -RW.Top);
    RV_DrawThemeBackground(FThemeEdit, DC, 0, 0, RW, nil);
    Msg.Result := 0;
  finally
    ReleaseDC(Handle, DC);
  end;
end;

procedure TRVColorCombo.CMMouseEnter(var Msg: TMessage);
begin
  FHot := True;
  if FThemeCombo<>0 then
    Repaint;
end;

procedure TRVColorCombo.CMMouseLeave(var Msg: TMessage);
begin
  FHot := False;
  if FThemeCombo<>0 then
    Repaint;
end;

function TRVColorCombo.GetCaption: String;
begin
  if FDefaultCaption<>'' then
    Result := FDefaultCaption
  else
    if AutoColor=clNone then
      Result := FTransparentCaption
    else
      Result := FAutoCaption;
end;

procedure TRVColorCombo.DrawStandard;
var w,L: Integer;
    r: TRect;
    State: Integer;
    s: String;
begin
  r := ClientRect;
  Canvas.Brush.Color := clWindow;
  Canvas.FillRect(r);
  w := GetSystemMetrics(SM_CXVSCROLL);
  r.Left := r.Right-w;
  if not Enabled then
    State := DFCS_INACTIVE
  else if csLButtonDown in ControlState then
    State := DFCS_PUSHED
  else
    State := 0;
  DrawFrameControl(Canvas.Handle, r, DFC_SCROLL, DFCS_SCROLLCOMBOBOX or State);
  r.Right := r.Left;
  r.Left := 0;
  InflateRect(r,-2,-2);
  if not Indeterminate and (ChosenColor<>clNone) then begin
    Canvas.Brush.Color := ChosenColor;
    Canvas.FillRect(r);
  end;
  if Focused then begin
    InflateRect(r,1,1);
    Canvas.Font.Color := clBlack;
    Canvas.Brush.Style := bsSolid;
    Canvas.Brush.Color := clWindow;
    Canvas.DrawFocusRect(r);
  end;
  if not Indeterminate and (ChosenColor=AutoColor) then begin
    Canvas.Font := Font;
    if AutoColor=clWindowText then
      Canvas.Font.Color := clWindow
    else if AutoColor=clNone then
      Canvas.Font.Color := clWindowText
    else begin
      L := GetLuminance(ChosenColor);
      if L>150 then
        Canvas.Font.Color := clWindowText
      else
        Canvas.Font.Color := clWindow;
    end;
    s := GetCaption;
    Canvas.Brush.Style := bsClear;
    Windows.DrawText(Canvas.Handle, PChar(s), Length(s), r, DT_SINGLELINE or DT_CENTER or DT_VCENTER)
  end;
end;

{$IFDEF USERVKSDEVTE}

procedure TRVColorCombo.SNMThemeMessage(var Msg: TMessage);
var
  R: TRect;
begin
  if not HandleAllocated then Exit;
  case Msg.wParam of
    SMP_REPAINT, SMP_APPLYTHEME, SMP_CHANGETHEME, SMP_REMOVETHEME:
      begin
        SendMessage(Handle, WM_NCPAINT, 0, 0);
        R := GetClientRect;
        InvalidateRect(Handle, @R, true);
      end;
  end;
end;

procedure TRVColorCombo.DrawKSThemed;
var w: Integer;
    r: TRect;
    L: Integer;
    s: String;
    DS: TteEditButtonDrawState;
begin
  r := ClientRect;
  Canvas.Brush.Color := CurrentTheme.Colors[ktcEditNormal];
  Canvas.FillRect(R);

  w := GetSystemMetrics(SM_CXVSCROLL);
  r.Left := r.Right-w;
  if not Enabled then
    DS := kebdsDisabled
  else
    if csLButtonDown in ControlState then
      DS := kebdsPressed
    else
      if FHot and (frm=nil) then
        DS := kebdsHot
      else
        DS := kebdsNormal;

  CurrentTheme.EditDrawButton(kescComboBox, Canvas, 
    EditButtonInfo(R, DS, kebcDropDown));

  r.Right := r.Left;
  r.Left := 0;
  InflateRect(r,-2,-2);
  if not Indeterminate and (ChosenColor<>clNone) then begin
    Canvas.Brush.Color := ChosenColor;
    Canvas.FillRect(r);
  end;
  if Focused then begin
    InflateRect(r,1,1);
    Canvas.Font.Color := clBlack;
    Canvas.Brush.Style := bsSolid;
    Canvas.Brush.Color := clWindow;
    Canvas.DrawFocusRect(r);
  end;
  if not Indeterminate and (ChosenColor=AutoColor) then
  begin
    Canvas.Font := Font;
    if AutoColor=clWindowText then
      Canvas.Font.Color := clWindow
    else if AutoColor=clNone then
      Canvas.Font.Color := clWindowText
    else begin
      L := GetLuminance(ChosenColor);
      if L>150 then
        Canvas.Font.Color := clWindowText
      else
        Canvas.Font.Color := clWindow;
    end;
    s := GetCaption;
    Canvas.Brush.Style := bsClear;
    Windows.DrawText(Canvas.Handle, PChar(s), Length(s), r, DT_SINGLELINE or DT_CENTER or DT_VCENTER)
  end;
end;

{$ENDIF}

procedure TRVColorCombo.DrawThemed;
var w: Integer;
    r: TRect;
    L: Integer;
    State: Integer;
    s: String;
begin
  r := ClientRect;
  Canvas.Brush.Color := clWindow;
  Canvas.FillRect(r);
  w := GetSystemMetrics(SM_CXVSCROLL);
  r.Left := r.Right-w;
  if not Enabled then
    State := CBXS_DISABLED
  else if csLButtonDown in ControlState then
    State := CBXS_PRESSED
  else if FHot and (frm=nil) then
    State := CBXS_HOT
  else
    State := CBXS_NORMAL;
  RV_DrawThemeBackground(FThemeCombo, Canvas.Handle, CP_DROPDOWNBUTTON, State, R, nil);
  r.Right := r.Left;
  r.Left := 0;
  InflateRect(r,-2,-2);
  if not Indeterminate and (ChosenColor<>clNone) then begin
    Canvas.Brush.Color := ChosenColor;
    Canvas.FillRect(r);
  end;
  if Focused then begin
    InflateRect(r,1,1);
    Canvas.Font.Color := clBlack;
    Canvas.Brush.Style := bsSolid;
    Canvas.Brush.Color := clWindow;
    Canvas.DrawFocusRect(r);
  end;
  if not Indeterminate and (ChosenColor=AutoColor) then begin
    Canvas.Font := Font;
    if AutoColor=clWindowText then
      Canvas.Font.Color := clWindow
    else if AutoColor=clNone then
      Canvas.Font.Color := clWindowText
    else begin
      L := GetLuminance(ChosenColor);
      if L>150 then
        Canvas.Font.Color := clWindowText
      else
        Canvas.Font.Color := clWindow;
    end;
    s := GetCaption;
    Canvas.Brush.Style := bsClear;
    Windows.DrawText(Canvas.Handle, PChar(s), Length(s), r, DT_SINGLELINE or DT_CENTER or DT_VCENTER)
  end;
end;

procedure TRVColorCombo.SetIndeterminate(const Value: Boolean);
begin
  FIndeterminate := Value;
  Invalidate;
end;

procedure TRVColorCombo.SetChosenColor(const Value: TColor);
begin
  FChosenColor  := Value;
  Indeterminate := False;
end;

procedure TRVColorCombo.SetColorDialog(const Value: TColorDialog);
begin
  if Value <> FColorDialog then
  begin
    {$IFDEF RICHVIEWDEF5}
    if FColorDialog <> nil then
      FColorDialog.RemoveFreeNotification(Self);
    {$ENDIF}
    FColorDialog := Value;
    if FColorDialog<> nil then
      FColorDialog.FreeNotification(Self);
  end;
end;


procedure TRVColorCombo.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited;
  if (Operation=opRemove) and (AComponent=FColorDialog) then
    FColorDialog := nil;
end;

procedure TRVColorCombo.CMEnabledChanged(var Msg: TMessage);
begin
  inherited;
  Invalidate;
end;

function TRVColorCombo.StoreAutoCaption: Boolean;
begin
  Result := FAutoCaption<>sAutoCpt;
end;

function TRVColorCombo.StoreTransparentCaption: Boolean;
begin
  Result := FTransparentCaption<>sTransparentCpt;
end;

end.