cxstylesheeteditor.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 534 行 · 第 1/2 页

  ACount := GetPropList(FStyleSheet.GetStyles.ClassInfo, [tkClass], @APropList);
  try
    lbStyles.Items.BeginUpdate;
    for I := 0 to ACount - 1 do
      if GetTypeData(APropList[I].PropType^).ClassType = TcxStyle then
      begin
        AStyle := TcxStyle(GetObjectProp(AStyleSheet.GetStyles, APropList[I].Name));
        ACacheStyle := TcxStyle.Create(Self);
        if AStyle <> nil then
          ACacheStyle.Assign(AStyle);
        SetObjectProp(FStyleSheet.GetStyles, APropList[I], ACacheStyle);
        FStyleList.Add(ACacheStyle);
        lbStyles.Items.Add(APropList[I].Name);
      end;
  finally
    lbStyles.Items.EndUpdate;
  end;
  if GetPreviewByStyleSheetClass(TcxCustomStyleSheetClass(FStyleSheet.ClassType)) <> nil then
  begin
    FPreview := GetPreviewByStyleSheetClass(TcxCustomStyleSheetClass(FStyleSheet.ClassType)).Create(self);
    FPreview.Control.Parent := pnlPreviewClient;
    FPreview.Control.Align := alClient;
    FPreview.SetStyleSheet(FStyleSheet);
    Width := pnlStyles.Width + lbStyles.Left * 2 + FPreview.GetSize.X;
    if pnlPreviewClient.Height < FPreview.GetSize.Y then
      Height := Height + FPreview.GetSize.Y - pnlPreviewClient.Height;
  end else
  begin
    pnlPreview.Visible := False;
    Width := pnlStyles.Width + lbStyles.Left * 2;
    FPreview := nil;
  end;
end;

procedure TfrmcxStyleSheetEditor.UpdateStyles(AStyleSheet: TcxCustomStyleSheet;
        AGetStyleName: TcxStyleGetName);
begin
  CreateStyleSheetStyles(AStyleSheet, FStyleSheet, AGetStyleName)
end;

procedure TfrmcxStyleSheetEditor.UpdateState;

  procedure UpdateCheckBox(ACheckBox: TCheckBox; AStyleValue: TcxStyleValue);

    function SelectedStylesHaveSameAssignedValue: Boolean;
    var
      AIsStyleValueAssigned: Boolean;
      I: Integer;
    begin
      AIsStyleValueAssigned := AStyleValue in GetFirstSelectedStyle.AssignedValues;
      Result := True;
      for I := 0 to lbStyles.Items.Count - 1 do
        if lbStyles.Selected[I] and ((AStyleValue in TcxStyle(FStyleList[I]).AssignedValues) <> AIsStyleValueAssigned) then
        begin
          Result := False;
          Break;
        end;
    end;

    function GetCheckBoxState: TCheckBoxState;
    const
      ACheckBoxStateMap: array [Boolean] of TCheckBoxState = (cbUnchecked, cbChecked);
    begin
      Result := cbUnchecked;
      if ACheckBox.Enabled then
        if SelectedStylesHaveSameAssignedValue then
          Result := ACheckBoxStateMap[AStyleValue in GetFirstSelectedStyle.AssignedValues]
        else
          Result := cbGrayed
    end;

  begin
    ACheckBox.Enabled := lbStyles.SelCount > 0;
    ACheckBox.State := GetCheckBoxState;
  end;

begin
  FStateUpdating := True;
  try
    btnBitmap.Enabled := lbStyles.SelCount > 0;
    btnColor1.Enabled := btnBitmap.Enabled;
    btnFont1.Enabled := btnBitmap.Enabled;

    UpdateCheckBox(cbBitmap, svBitmap);
    UpdateCheckBox(cbColor, svColor);
    UpdateCheckBox(cbFont, svFont);
  finally
    FStateUpdating := False;
  end;
end;

procedure TfrmcxStyleSheetEditor.lbStylesClick(Sender: TObject);
begin
  UpdateState;
end;

procedure TfrmcxStyleSheetEditor.lbStylesMeasureItem(Control: TWinControl;
  Index: Integer; var Height: Integer);
var
  AcxCanvas: TcxCanvas;
begin
  if Index >= FStyleList.Count then exit;
  if (svFont in TcxStyle(FStyleList[Index]).AssignedValues) then
  begin
    AcxCanvas := TcxCanvas.Create(lbStyles.Canvas);
    try
      AcxCanvas.Font.Assign(TcxStyle(FStyleList[Index]).Font);
      Height := AcxCanvas.TextHeight(lbStyles.Items[Index]) + 2;
    finally
      AcxCanvas.Free;
    end;
  end;
end;

procedure TfrmcxStyleSheetEditor.lbStylesDrawItem(Control: TWinControl;
  Index: Integer; Rect: TRect; State: TOwnerDrawState);
var
  AFlags: Longint;
  ASelected: Boolean;
  AStyle: TcxStyle;
  AText: string;
  APrevTextColor: TColor;
begin
  ASelected := odSelected in State;
  AStyle := TcxStyle(FStyleList[Index]);

  if not ASelected and (svColor in AStyle.AssignedValues) then
    lbStyles.Canvas.Brush.Color := AStyle.Color;
  if not ASelected and (svBitmap in AStyle.AssignedValues) then
  begin
    FCanvas.Canvas := lbStyles.Canvas;
    FCanvas.FillRect(Rect, AStyle.Bitmap);
  end
  else
    lbStyles.Canvas.FillRect(Rect);

  AFlags := DrawTextBiDiModeFlags(DT_SINGLELINE or DT_VCENTER or DT_NOPREFIX);
  Inc(Rect.Left, 2);
  AText := lbStyles.Items[Index];
  if (svFont in AStyle.AssignedValues) then
  begin
    APrevTextColor := lbStyles.Canvas.Font.Color;
    lbStyles.Canvas.Font.Assign(AStyle.Font);
    lbStyles.Canvas.Font.Color := APrevTextColor;
  end;
  if (svTextColor in AStyle.AssignedValues) and not ASelected then
    lbStyles.Canvas.Font.Color := AStyle.TextColor;
  lbStyles.Canvas.Brush.Style := bsClear;
  DrawText(lbStyles.Canvas.Handle, PChar(AText), Length(AText), Rect, AFlags);
  lbStyles.Canvas.Brush.Style := bsSolid;
end;

var
  FStyleSheetPreviews: TList = nil;

procedure RegisterStyleSheetEditorPreview(APreviewClass: TcxStyleSheetEditorPreviewClass);
begin
  if FStyleSheetPreviews = nil then
    FStyleSheetPreviews := TList.Create;
  if FStyleSheetPreviews.IndexOf(TObject(APreviewClass)) < 0 then
    FStyleSheetPreviews.Add(TObject(APreviewClass));
end;

procedure UnregisterStyleSheetEditorPreview(APreviewClass: TcxStyleSheetEditorPreviewClass);
begin
  if FStyleSheetPreviews <> nil then
    FStyleSheetPreviews.Remove(TObject(APreviewClass));
end;

function GetPreviewByStyleSheetClass(AStyleSheetClass: TcxCustomStyleSheetClass): TcxStyleSheetEditorPreviewClass;
var
  I: Integer;
begin
  Result := nil;
  if FStyleSheetPreviews <> nil then
    for I := 0 to FStyleSheetPreviews.Count - 1 do
      if (TcxStyleSheetEditorPreviewClass(FStyleSheetPreviews[I]).GetStyleSheetClass = AStyleSheetClass) then
      begin
        Result := TcxStyleSheetEditorPreviewClass(FStyleSheetPreviews[I]);
        Break;
      end;
end;

procedure TfrmcxStyleSheetEditor.cbClick(Sender: TObject);
begin
  if not FStateUpdating then
    try
      SetSelectedStylesAssignValue(TCheckBox(Sender));
    finally
      if Sender = cbFont then
        RecreateListBox(lbStyles)
      else
        lbStyles.Invalidate;
      UpdateState;
    end;
end;

procedure TfrmcxStyleSheetEditor.btnColor1Click(Sender: TObject);
var
  I: Integer;
begin
  ColorDialog.Color := TcxStyle(FStyleList[lbStyles.ItemIndex]).Color;
  if ColorDialog.Execute then
    try
      for I := 0 to lbStyles.Items.Count - 1 do
        if lbStyles.Selected[I] then
          TcxStyle(FStyleList[I]).Color := ColorDialog.Color;
    finally
      lbStyles.Invalidate;
      UpdateState;
    end;
end;

procedure TfrmcxStyleSheetEditor.btnFont1Click(Sender: TObject);
var
  I: Integer;
begin
  FontDialog.Font.Assign(TcxStyle(FStyleList[lbStyles.ItemIndex]).Font);
  FontDialog.Font.Color := TcxStyle(FStyleList[lbStyles.ItemIndex]).TextColor;
  if FontDialog.Execute then
    try
      for I := 0 to lbStyles.Items.Count - 1 do
        if lbStyles.Selected[I] then
        begin
          TcxStyle(FStyleList[I]).Font.Assign(FontDialog.Font);
          TcxStyle(FStyleList[I]).TextColor := FontDialog.Font.Color;
        end;
    finally
      RecreateListBox(lbStyles);
      UpdateState;
    end;
end;

procedure TfrmcxStyleSheetEditor.btnBitmapClick(Sender: TObject);
var
  I: Integer;
  AOpenPictureDialog: TOpenPictureDialog;
begin
  AOpenPictureDialog := TOpenPictureDialog.Create(nil);
  try
    with AOpenPictureDialog do
    begin
      Filter := 'Bitmaps (*.bmp)|*.bmp';
      Options := [{$IFDEF DELPHI7}ofHideReadOnly, {$ENDIF}ofFileMustExist, ofEnableSizing];
      FileName := '';
    end;
    if AOpenPictureDialog.Execute then
      try
        for I := 0 to lbStyles.Items.Count - 1 do
          if lbStyles.Selected[I] then
            TcxStyle(FStyleList[I]).Bitmap.LoadFromFile(AOpenPictureDialog.FileName);
      finally
        lbStyles.Invalidate;
        UpdateState;
      end;
  finally
    AOpenPictureDialog.Free;
  end;
end;

initialization

finalization
  FStyleSheetPreviews.Free;
  FStyleSheetPreviews := nil;
end.