cxstyles.pas

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

  begin
    if UseStyle(AStyle, svFont) then
      Result := AStyle.Font
    else
      if UseStyle(AAssignedStyle, svFont) then
        Result := AAssignedStyle.Font
      else
        Result := nil;
  end;

  function GetTextColor: TColor;
  begin
    if UseStyle(AStyle, svTextColor) then
      Result := AStyle.TextColor
    else
      if UseStyle(AAssignedStyle, svTextColor) then
        Result := AAssignedStyle.TextColor
      else
        Result := clDefault;
  end;

begin
  AAssignedStyle := Values[Index];
  with AParams do
  begin
    if BitmapInViewParams then
      Bitmap := GetBitmap
    else
      Bitmap := nil;
    Color := GetColor;
    Font := GetFont;
    TextColor := GetTextColor;
    if BitmapInViewParams and (Bitmap = nil) or
      (Color = clDefault) or (Font = nil) or (TextColor = clDefault) then
    begin
      GetDefaultViewParams(Index, AData, ADefaultParams);
      if Bitmap = nil then
        Bitmap := ADefaultParams.Bitmap;
      if Color = clDefault then
        Color := ADefaultParams.Color;
      if Font = nil then
        Font := ADefaultParams.Font;
      if TextColor = clDefault then
        TextColor := ADefaultParams.TextColor;
    end;
  end;
end;

procedure CreateStyleSheetStyles(ADestStyleSheet, ASourceStyleSheet: TcxCustomStyleSheet;
  AStyleGetName: TcxStyleGetName = nil);
var
  APropList: TPropList;
  I, ACount: Integer;
  ADestStyle, ASourceStyle: TcxStyle;
begin
  if ADestStyleSheet.GetStylesClass <> ASourceStyleSheet.GetStylesClass then Exit;
  ACount := GetPropList(ADestStyleSheet.GetStyles.ClassInfo, [tkClass], @APropList);
  for I := 0 to ACount - 1 do
    if GetTypeData(APropList[I].PropType^).ClassType = TcxStyle then
    begin
      ADestStyle := TcxStyle(GetObjectProp(ADestStyleSheet.GetStyles, APropList[I].Name));
      ASourceStyle := TcxStyle(GetObjectProp(ASourceStyleSheet.GetStyles, APropList[I].Name));
      if ASourceStyle <> nil then
      begin
        if ADestStyle <> nil then
          ADestStyle.Assign(ASourceStyle)
        else
          if (ADestStyleSheet.StyleRepository <> nil) and
            (ASourceStyle.AssignedValues <> []) then
          begin
            ADestStyle := TcxStyle(ADestStyleSheet.StyleRepository.CreateItemEx(TcxStyle, ADestStyleSheet.Owner));
            if Assigned(AStyleGetName) then
              ADestStyle.Name := AStyleGetName(ADestStyle);
            ADestStyle.Assign(ASourceStyle);
            SetObjectProp(ADestStyleSheet.GetStyles, APropList[I], ADestStyle);
          end;
      end
      else
        SetObjectProp(ADestStyleSheet.GetStyles, APropList[I], nil);
    end;
end;

var
  FStyleSheetClasses: TList = nil;

procedure RegisterStyleSheetClass(AStyleSheetClass: TcxCustomStyleSheetClass);
begin
  if FStyleSheetClasses = nil then
    FStyleSheetClasses := TList.Create;
  if FStyleSheetClasses.IndexOf(TObject(AStyleSheetClass)) = -1 then
    FStyleSheetClasses.Add(TObject(AStyleSheetClass));
end;

procedure UnregisterStyleSheetClass(AStyleSheetClass: TcxCustomStyleSheetClass);
begin
  if FStyleSheetClasses <> nil then
    FStyleSheetClasses.Remove(TObject(AStyleSheetClass));
end;

procedure GetRegisteredStyleSheetClasses(AList: TList);
var
  I: Integer;
begin
  AList.Clear;
  if FStyleSheetClasses <> nil then
    for I := 0 to FStyleSheetClasses.Count - 1 do
       AList.Add(FStyleSheetClasses[I]);
end;

function ColorToText(AColor: TColor): string;
begin
  Result := IntToStr(AColor);
end;

function TextToColor(const ASt: string): TColor;
begin
  if CompareText(ASt, DefaultValue) <> 0 then
    Result := TColor(StrToInt(ASt))
  else Result := clDefault;
end;

function FontToText(AFont: TFont): string;
begin
  Result := AFont.Name + ',' + IntToStr(AFont.Size) + ',[';
  if fsBold in AFont.Style then
    Result := Result + 'B';
  if fsItalic in AFont.Style then
    Result := Result + 'I';
  if fsUnderline in AFont.Style then
    Result := Result + 'U';
  if fsStrikeOut in AFont.Style then
    Result := Result + 'S';
  Result := Result + ']';
end;

procedure TextToFont(const AFont: TFont; const ASt: string);
   procedure SetFontSize(AText: string);
   begin
     try
       AFont.Size := StrToInt(AText);
     except
     end;
   end;

var
  St: string;
begin
  st := ASt;
  if Pos(',', st) = 0 then
    AFont.Name := st
  else
  begin
    AFont.Name := Copy(st, 1, Pos(',', st) - 1);
    st := Copy(st, Pos(',', st) + 1, Length(st));
    if Pos(',', st) = 0 then
      SetFontSize(st)
    else
    begin
      SetFontSize(Copy(st, 1, Pos(',', st) - 1));
      st := Copy(st, Pos(',', st) + 1, Length(st));
      if Pos('B', st) > 0 then
        AFont.Style := AFont.Style + [fsBold];
      if Pos('I', st) > 0 then
        AFont.Style := AFont.Style + [fsItalic];
      if Pos('U', st) > 0 then
        AFont.Style := AFont.Style + [fsUnderline];
      if Pos('S', st) > 0 then
        AFont.Style := AFont.Style + [fsStrikeout];
    end;
  end;
end;

procedure SaveBitmapToIniFile(AIniFile: TCustomIniFile; ABitmap: TBitmap;
  const ASectionName, ABitmapName: string);
const
  AStringValueMaxLength = 2047;
var
  AStream: TMemoryStream;
  I: Integer;
  S: string;
begin
  AStream := TMemoryStream.Create;
  try
    ABitmap.SaveToStream(AStream);
    S := BinaryStreamToString(AStream);
  finally
    AStream.Free;
  end;
  for I := 0 to (Length(S) + AStringValueMaxLength - 1) div AStringValueMaxLength - 1 do
    AIniFile.WriteString(ASectionName, ABitmapName + IntToStr(I),
      Copy(S, 1 + I * AStringValueMaxLength, AStringValueMaxLength));
end;

procedure SaveStyleSheetsToIniFile(const AIniFileName: string; const AList: TList);
var
  AIsFileEmpty: Boolean;

  procedure SaveStyleToIni(AIniFile: TCustomIniFile; const AStyleSheetCaption, AStyleName: string;
    AStyle: TcxStyle);
  var
    Value: string;
  begin
    if svColor in AStyle.AssignedValues then
      Value := ColorToText(AStyle.Color)
    else
      Value := DefaultValue;
    if Value <> '' then
      Value := Value + ',';

    if svTextColor in AStyle.AssignedValues then
      Value := Value + ColorToText(AStyle.TextColor)
    else
      Value := Value + DefaultValue;

    if svFont in AStyle.AssignedValues then
    begin
      if Value <> '' then
        Value := Value + ',';
      Value := Value + FontToText(AStyle.Font);
    end;

    if Value <> '' then
    begin
      AIniFile.WriteString(AStyleSheetCaption, AStyleName, Value);
      AIsFileEmpty := False;
    end;

    if (svBitmap in AStyle.AssignedValues) and VerifyBitmap(AStyle.Bitmap) then
      SaveBitmapToIniFile(AIniFile, AStyle.Bitmap, AStyleSheetCaption, AStyleName + BitmapCaption);
  end;

  procedure SaveStyleSheetToIni(AStyleSheet: TcxCustomStyleSheet; AIniFile: TCustomIniFile);
  var
    I, ACount: Integer;
    APropList: TPropList;
    AStyle: TcxStyle;
  begin
    ACount := GetPropList(AStyleSheet.GetStyles.ClassInfo, [tkClass], @APropList);
    for I := 0 to ACount - 1 do
      if GetTypeData(APropList[I].PropType^).ClassType = TcxStyle then
      begin
        AStyle := TcxStyle(GetObjectProp(AStyleSheet.GetStyles, APropList[I]));
        if AStyle <> nil then
          SaveStyleToIni(AIniFile, AStyleSheet.Caption, APropList[I].Name, AStyle);
      end;
  end;

var
  AIniFile: TMemIniFile;
  F: TextFile;
  I: Integer;
begin
  AIsFileEmpty := True;
  try
    AIniFile := TMemIniFile.Create(AIniFileName);
    try
      for I := 0 to AList.Count - 1 do
        SaveStyleSheetToIni(TcxCustomStyleSheet(AList[I]), AIniFile);
      if not AIsFileEmpty then AIniFile.UpdateFile;
    finally
      AIniFile.Free;
    end;
  finally
    if AIsFileEmpty then
    begin
      AssignFile(F, AIniFileName);
      Rewrite(F);
      CloseFile(F);
    end;
  end;
end;

procedure LoadStyleSheetsFromIniFile(const AIniFileName: string;
  AStyleRepository: TcxStyleRepository; AStyleSheetClass: TcxCustomStyleSheetClass;
  const AStyleSheetNames: TStrings = nil; AOwner: TComponent = nil;
  const AStyleSheetList: TList = nil; AStyleGetName: TcxStyleGetName = nil);

  procedure LoadStyleFromIni(AIniFile: TCustomIniFile; AStyleSheet: TcxCustomStyleSheet;
    AStyleName: string; var AStyleNameIndex: Integer);
  var
    AIsBitmapValue: Boolean;
    AKey, S: string;
    APos: Integer;
    APropInfo: PPropInfo;
    AStream: TMemoryStream;
    AStyle: TcxStyle;
    I: Integer;
  begin
    if AStyleName = '' then
    begin
      Inc(AStyleNameIndex);
      Exit;
    end;
    APos := Pos(BitmapCaption, AStyleName);
    if APos > 0 then
    begin
      AIsBitmapValue := True;
      AStyleName := Copy(AStyleName, 1, APos - 1);
    end
    else
      AIsBitmapValue := False;

    APropInfo := GetPropInfo(PTypeInfo(AStyleSheet.GetStyles.ClassInfo), AStyleName);
    if (APropInfo <> nil) and (GetTypeData(APropInfo.PropType^).ClassType = TcxStyle) then
    begin
      if AIsBitmapValue then
      begin
        AStyle := TcxStyle(GetObjectProp(AStyleSheet.GetStyles, APropInfo));
        S := '';
        I := 0;
        repeat
          AKey := AStyleName + BitmapCaption + IntToStr(I);
          if not AIniFile.ValueExists(AStyleSheet.Caption, AKey) then
            Break;
          S := S + AIniFile.ReadString(AStyleSheet.Caption, AKey, '');
          Inc(AStyleNameIndex);
          Inc(I);
        until False;
        AStream := TMemoryStream.Create;
        try
          StringToBinaryStream(S, AStream);
          AStyle.Bitmap.LoadFromStream(AStream);
        finally
          AStream.Free;
        end;
      end
      else
      begin
        if AOwner <> nil then
          AStyle := TcxStyle(AStyleRepository.CreateItemEx(TcxStyle, AOwner))
        else AStyle := TcxStyle(AStyleRepository.CreateItem(TcxStyle));
        if Assigned(AStyleGetName) then
          AStyle.Name := AStyleGetName(AStyle);

        S := AIniFile.ReadString(AStyleSheet.Caption, AStyleName, '');
        if Pos(',', S) = 0 then
           AStyle.Color := TextToColor(S)
        else
        begin
          AStyle.Color := TextToColor(Copy(S, 1, Pos(',', S) - 1));
          S := Copy(S, Pos(',', S) + 1, Length(S));
          if Pos(',', S) = 0 then
             AStyle.TextColor := TextToColor(S)
          else
          begin
            AStyle.TextColor := TextToColor(Copy(S, 1, Pos(',', S) - 1));
            TextToFont(AStyle.Font, Copy(S, Pos(',', S) + 1, Length(S)));
          end;
        end;
        SetObjectProp(AStyleSheet.GetStyles, APropInfo, AStyle);
        Inc(AStyleNameIndex);
      end;
    end else Inc(AStyleNameIndex);
  end;

  procedure LoadStyleSheetFromIni(const AStyleSheetName: string; AIniFile: TCustomIniFile);
  var
    ANames: TStringList;
    AStyleSheet: TcxCustomStyleSheet;
    I: Integer;
  begin
    ANames := TStringList.Create;
    try
      AIniFile.ReadSection(AStyleSheetName, ANames);
      if ANames.Count > 0 then
      begin
        if AOwner <> nil then
          AStyleSheet := AStyleRepository.CreateStyleSheetEx(AStyleSheetClass, AOwner)
        else AStyleSheet := AStyleRepository.CreateStyleSheet(AStyleSheetClass);
        if AStyleSheetList <> nil then
          AStyleSheetList.Add(AStyleSheet);
        AStyleSheet.Caption := AStyleSheetName;
        I := 0;
        while I < ANames.Count do
          LoadStyleFromIni(AIniFile, AStyleSheet, ANames[I], I);
      end;
    finally
      ANames.Free;
    end;
  end;

var
  AIniFile: TMemIniFile;
  I: Integer;
  AStrings: TStringList;
begin
  AIniFile := TMemIniFile.Create(AIniFileName);
  AStrings := TStringList.Create;
  try
    if (AStyleSheetNames = nil) or (AStyleSheetNames.Count = 0) then
      AIniFile.ReadSections(AStrings)
    else
      AStrings.AddStrings(AStyleSheetNames);
    for I := 0 to AStrings.Count - 1 do
      LoadStyleSheetFromIni(AStrings[I], AIniFile);
  finally
    AStrings.Free;
    AIniFile.Free;
  end;
end;

initialization
{$IFDEF DELPHI6}
  StartClassGroup(TControl);
  GroupDescendentsWith(TcxCustomStyle, TControl);
  GroupDescendentsWith(TcxCustomStyleSheet, TControl);
  GroupDescendentsWith(TcxStyleRepository, TControl);
{$ENDIF}
  RegisterClasses([TcxStyle]);

finalization
  FreeAndNil(FStyleSheetClasses);

end.