dxskinscore.pas

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

PAS
2,155
字号
    begin
      for I := 0 to TdxSkinPersistent(Source).PropertyCount - 1 do
        AddSubItem(TdxSkinPersistent(Source).Properties[I].Clone, FProperties);
    end
    else
      inherited Assign(Source);
  finally
    EndUpdate;
  end;
end;

function TdxSkinPersistent.AddProperty(
  const AName: string; APropertyClass: TdxSkinPropertyClass): TdxSkinProperty;
begin
  Result := APropertyClass.Create(Self, AName);
  AddSubItem(Result, FProperties);
end;

procedure TdxSkinPersistent.BeginUpdate;
begin
  Inc(FLockCount);
end;

procedure TdxSkinPersistent.CancelUpdate;
begin
  Dec(FLockCount);
end;

procedure TdxSkinPersistent.DeleteProperty(const AProperty: TdxSkinProperty);
begin
  if FProperties.Remove(AProperty) <> -1 then
  begin
    AProperty.Free;
    Changed;
  end;
end;

procedure TdxSkinPersistent.EndUpdate;
begin
  Dec(FLockCount);
  if FLockCount = 0 then
    Changed;
end;

procedure TdxSkinPersistent.Sort;
begin
  SetSorted(True);
end;

procedure TdxSkinPersistent.AddSubItem(
  AInstance: TdxSkinCustomPersistentObject; AList: TcxObjectList);
begin
  AInstance.FOwner := Self;
  AInstance.OnChange := SubItemHandler;
  AList.Add(AInstance);
  Changed;
end;

procedure TdxSkinPersistent.Changed;
begin
  Modified := True; 
  FSorted := False;
  if LockCount = 0 then
    DoChange;
end;

procedure TdxSkinPersistent.DoSort;
begin
  FProperties.Sort(TListSortCompare(@dxCompareByName));
end;

procedure TdxSkinPersistent.SubItemHandler(Sender: TObject);
begin
  Changed;
end;

procedure TdxSkinPersistent.ReadProperties(AStream: TStream);
var
  I: Integer;
  APropClass: TdxSkinPropertyClass;
begin
  for I := 0 to ReadInteger(AStream) - 1 do
  begin
    APropClass := TdxSkinPropertyClass(FindClass(ReadStringFromStream(AStream)));
    AddProperty(ReadStringFromStream(AStream), APropClass).ReadData(AStream);
  end;
end;

procedure TdxSkinPersistent.WriteProperties(AStream: TStream);
var
  I: Integer;
begin
  WriteInteger(AStream, PropertyCount);
  for I := 0 to PropertyCount -1 do
    Properties[I].WriteToStream(AStream);
end;

function TdxSkinPersistent.GetPropertyByName(const AName: string): TdxSkinProperty;
begin
  Sort;
  Result := TdxSkinProperty(FindItemByName(FProperties, AName));
end;

function TdxSkinPersistent.GetPropertyCount: Integer;
begin
  Result := FProperties.Count;
end;

function TdxSkinPersistent.GetProperty(Index: Integer): TdxSkinProperty;
begin
  Result := FProperties[Index] as TdxSkinProperty;
end;

procedure TdxSkinPersistent.SetSorted(AValue: Boolean);
begin
  if AValue <> FSorted then
  begin
    FSorted := AValue;
    if AValue then
      DoSort;
  end;
end;

{ TdxSkin }

constructor TdxSkin.Create(const AName: string;
  ALoadOnCreate: Boolean; hInst: THandle);
begin
  inherited Create(nil, AName);
  FListeners := TInterfaceList.Create;
  FColors := TcxObjectList.Create;
  FGroups := TcxObjectList.Create;
  FVersion := dxSkinStreamVersion;
  FName := AName;
  if ALoadOnCreate then
    LoadFromResource(hInst);
end;

destructor TdxSkin.Destroy;
begin
  FListeners.Free;
  FColors.Free;
  FGroups.Free;
  inherited Destroy;
end;

procedure TdxSkin.ClearModified;
var
  I: Integer;
begin
  FModified := False;
  for I := 0 to GroupCount - 1 do
    Groups[I].ClearModified;
end;

function TdxSkin.Clone(const AName: string): TdxSkin;
var
  AClass: TdxSkinClass;
begin
  AClass := TdxSkinClass(ClassType);
  Result := AClass.Create(Name, False, 0);
  Result.Assign(Self);
end;

procedure TdxSkin.Assign(Source: TPersistent);
var
  I: Integer;
begin
  BeginUpdate;
  try
    if Source is TdxSkin then
    begin
      // clone colors
      for I := 0 to TdxSkin(Source).ColorCount - 1 do
        AddSubItem(TdxSkin(Source).Colors[I].Clone, FColors);
      for I := 0 to TdxSkin(Source).GroupCount - 1 do
        AddSubItem(TdxSkin(Source).Groups[I].Clone, FGroups);
    end;
    inherited Assign(Source);
  finally
    EndUpdate;
  end;
end;

function TdxSkin.AddColor(
  const AName: string; const AColor: TColor): TdxSkinColor;
begin
  Result := TdxSkinColor.Create(Self, AName);
  BeginUpdate;
  try
    AddSubItem(Result, FColors);
    Result.Value := AColor;
  finally
    EndUpdate;
  end;
end;

function TdxSkin.AddGroup(const AName: string): TdxSkinControlGroup;
begin
  Result := TdxSkinControlGroup.Create(Self, AName);
  AddSubItem(Result, FGroups);
end;

procedure TdxSkin.AddListener(AListener: IdxSkinChangeListener);
begin
  Listeners.Add(AListener);
end;

procedure TdxSkin.Clear;
begin
  FGroups.Clear;
  FColors.Clear;
  FProperties.Clear;
end;

function TdxSkin.GetColorByName(const AName: string): TdxSkinColor;
begin
  Sort;
  Result := TdxSkinColor(FindItemByName(FColors, AName));
end;

procedure TdxSkin.DeleteProperty(const AProperty: TdxSkinProperty);
begin
  inherited DeleteProperty(AProperty);
  if FColors.Remove(AProperty) <> -1 then
  begin
    AProperty.Free;
    Changed;
  end;
end;

function TdxSkin.GetGroupByName(const AName: string): TdxSkinControlGroup;
begin
  Sort;
  Result := TdxSkinControlGroup(FindItemByName(FGroups, AName));
end;

procedure TdxSkin.LoadFromStream(AStream: TStream);
var
  I: Integer;
begin
  if not CheckGdiPlus then Exit;
  if not dxSkinCheckSignature(AStream, FVersion) then
    raise EdxSkin.Create(sdxSkinInvalidStreamFormat);
  FName := ReadStringFromStream(AStream);
  dxSkinCheckVersion(FVersion);
  BeginUpdate;
  try
    Clear;
    for I := 0 to ReadInteger(AStream) - 1 do
    begin
      if FVersion >= 0.92 then
        ReadStringFromStream(AStream);
      AddColor(ReadStringFromStream(AStream), ReadInteger(AStream));
    end;
    ReadProperties(AStream);
    for I := 0 to ReadInteger(AStream) - 1 do
      AddGroup(ReadStringFromStream(AStream)).ReadData(AStream, Version);
  finally
    EndUpdate;
  end;
end;

procedure TdxSkin.LoadFromFile(const AFileName: string);
var
  AStream: TStream;
begin
  AStream := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyNone);
  try
    LoadFromStream(AStream);
  finally
    AStream.Free
  end;
end;

procedure TdxSkin.RemoveListener(AListener: IdxSkinChangeListener);
begin
  Listeners.Remove(AListener);
end;

procedure TdxSkin.SaveToFile(const AFileName: string);
var
  AStream: TStream;
begin
  AStream := TFileStream.Create(AFileName, fmCreate);
  try
    SaveToStream(AStream);
  finally
    AStream.Free
  end;
end;

procedure TdxSkin.SaveToStream(AStream: TStream);
var
  I: Integer;
begin
  dxSkinWriteSignature(AStream);
  WriteStringToStream(AStream, Name);
  WriteInteger(AStream, ColorCount);
  for I := 0 to ColorCount - 1 do
    Colors[I].WriteToStream(AStream);
  WriteProperties(AStream);
  WriteInteger(AStream, GroupCount);
  for I := 0 to GroupCount - 1 do
    Groups[I].WriteData(AStream);
end;


procedure TdxSkin.DoChange;
begin
  NotifyListeners;
  if Assigned(FOnChange) then
    FOnChange(Self);
end;

procedure TdxSkin.DoSort;
begin
  inherited DoSort;
  FGroups.Sort(TListSortCompare(@dxCompareByName));
  FColors.Sort(TListSortCompare(@dxCompareByName));
end;

procedure TdxSkin.NotifyListeners;
var
  I: Integer;
begin
  Inc(FLockCount);
  try
    for I := 0 to Listeners.Count - 1 do
      IdxSkinChangeListener(Listeners[I]).SkinChanged(Self);
  finally
    Dec(FLockCount);
  end;
end;

procedure TdxSkin.LoadFromResource(hInst: THandle);
var
  AStream: TStream;
begin
  AStream := TResourceStream.Create(hInst, Name, PChar(sdxResourceType));
  try
    LoadFromStream(AStream);
  finally
    AStream.Free;
  end;
end;

function TdxSkin.GetColor(Index: Integer): TdxSkinColor;
begin
  Result := FColors[Index] as TdxSkinColor;  
end;

function TdxSkin.GetColorCount: Integer;
begin
  Result := FColors.Count;
end;

function TdxSkin.GetGroup(Index: Integer): TdxSkinControlGroup;
begin
  Result := FGroups[Index] as TdxSkinControlGroup;
end;

function TdxSkin.GetGroupCount: Integer;
begin
  Result := FGroups.Count;
end;

procedure TdxSkin.SetName(const Value: string);
begin
  FName := Value;
end;

{  TdxSkinImage }

constructor TdxSkinImage.Create(AOwner: TdxSkinElement);
begin
  FOwner := AOwner;
  FTexture := TdxPNGImage.Create();
  FMargins := TcxRect.Create(Self);
  FMargins.OnChange := SubItemHandler;
  FGradientBeginColor := clNone;
  FGradientEndColor := clNone;
  FGradient := gmHorizontal;
  FTransparentColor := clNone;
end;

destructor TdxSkinImage.Destroy;
begin
  FMargins.Free;
  FTexture.Free;
  inherited Destroy;
end;

procedure TdxSkinImage.Assign(Source: TPersistent);
begin
  if not (Source is TdxSkinImage) then Exit;
  if TdxSkinImage(Source).Empty then
    Clear
  else
  begin
    Texture.Assign(TdxSkinImage(Source).Texture);
    FSourceName := TdxSkinImage(Source).SourceName;
    FIsDirty := True;
  end;
  GradientBeginColor := TdxSkinImage(Source).GradientBeginColor;
  GradientEndColor := TdxSkinImage(Source).GradientEndColor;
  Gradient := TdxSkinImage(Source).Gradient;
  ImageLayout := TdxSkinImage(Source).ImageLayout;
  Margins.Assign(TdxSkinImage(Source).Margins);
  States := TdxSkinImage(Source).States;
  Stretch := TdxSkinImage(Source).Stretch;
end;

procedure TdxSkinImage.Clear;
begin
  Texture.Handle := nil;
  FSourceName := '';
  DoChange;
end;

procedure TdxSkinImage.GetBitmap(AImageIndex: Integer; 
  AState: TdxSkinElementState; ABitmap: TBitmap; ABkColor: TColor = clNone);
begin
  ABitmap.FreeImage;
  ABitmap.Width := Size.cx;
  ABitmap.Height := Size.cy;
  if ABkColor <> clNone then
  begin
    if ABkColor <> clDefault then
      ABitmap.Canvas.Brush.Color := ABkColor;
    ABitmap.Canvas.FillRect(Rect(0, 0, Size.cx, Size.cy));

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?