dxskinscore.pas

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

  end;
  Draw(ABitmap.Canvas.Handle, Rect(0, 0, Size.cx, Size.cy), AImageIndex, AState);
end;

procedure TdxSkinImage.LoadFromFile(const AFileName: string);
var
  AFile : TFileStream;
begin
  FSourceName := AFileName;
  AFile := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyNone);
  try
    Texture.LoadFromStream(AFile);
  finally
    AFile.Free;
  end;
  DoChange;
end;

procedure TdxSkinImage.SaveToFile(const AFileName: string);
begin
  if Empty then Exit;
  Texture.SaveToFile(ChangeFileExt(AFileName, '.png'));
  DoChange;
end;

procedure TdxSkinImage.SetStateMapping(AStateOrder: array of TdxSkinElementState);
var
  ASrc: TRect;
  ASize: TSize;
  ABitmap: TBitmap;
  AIndex, AImageIndex: Integer;
begin
  if Texture.Empty then Exit;
  ABitmap := Texture.GetAsBitmap;
  try
    ASize := Size;
    ASrc := Rect(0, 0, ASize.cx, ASize.cy);
    if ImageLayout = ilHorizontal then
      ASize.cy := 0
    else
      ASize.cx := 0;
    for AImageIndex := 0 to ImageCount - 1 do
      for AIndex := Low(AStateOrder) to High(AStateOrder) do
      begin
        if not (AStateOrder[AIndex] in States) then Continue;
        Texture.StretchDraw(ABitmap.Canvas.Handle,
          StateBounds[AImageIndex, AStateOrder[AIndex]], ASrc);
        OffsetRect(ASrc, ASize.cx, ASize.cy);
      end;
    Texture.SetBitmap(ABitmap);
  finally
    ABitmap.Free;
  end;
end;

procedure TdxSkinImage.CheckInfo;
begin
  if not IsDirty then Exit;
  IsDirty := False;
  DoInitializeInfo;
end;

procedure TdxSkinImage.CheckState(var AState: TdxSkinElementState);
var
  AFirstState: TdxSkinElementState;
begin
  if not (AState in FStates) then
    for AFirstState := Low(TdxSKinElementState) to High(TdxSKinElementState) do
      if AFirstState in FStates then
      begin
        AState := AFirstState;
        Break;
      end;
end;

function TdxSkinImage.Compare(AImage: TdxSkinImage): Boolean; 
begin
  Result := (AImage.ImageLayout = ImageLayout) and (AImage.Empty = Empty) and
    (AImage.States = States) and (AImage.Gradient = Gradient) and
    (AImage.GradientBeginColor = GradientBeginColor) and
    (AImage.GradientEndColor = GradientEndColor) and (AImage.Stretch = Stretch) and
    (AImage.Size.cx = Size.cx) and (AImage.Size.cy = Size.cy) and
    AImage.Margins.IsEqual(Margins.Rect) and Texture.Compare(AImage.Texture);
end;

procedure TdxSkinImage.Draw(DC: HDC; const ARect: TRect;
  AImageIndex: Integer = 0; AState: TdxSkinElementState = esNormal);
var
  ACanvas: TdxSkinCanvas;
begin
  CheckInfo;
  if (FSize.cx <= 0) or (FSize.cy <= 0) or IsRectEmpty(ARect) or not RectVisible(DC, ARect) then Exit;
  ACanvas := TdxSkinCanvas.Create;
  try
    ACanvas.BeginPaint(DC, ARect);
    DrawEx(ACanvas, ARect, AImageIndex, AState);
    ACanvas.EndPaint;
  finally
    ACanvas.Free;
  end;
end;

procedure TdxSkinImage.DrawEx(ACanvas: TdxSkinCanvas; const ARect: TRect;
  AImageIndex: Integer = 0; AState: TdxSkinElementState = esNormal);
var
  ACol, ARow: Integer;
  AVisibility: TdxSkinElementPartVisibility;
  DestParts, SourceParts: TdxSkinElementPartBounds;
begin
  if Empty then Exit;
  CheckInfo;
  CheckState(AState);
  if Stretch = smNoResize then
    ACanvas.DrawImage(Texture, cxRectCenter(ARect, Size), StateBounds[AImageIndex, AState])
  else
  begin
    FillChar(AVisibility, SizeOf(AVisibility), 1);
    InitializePartsInfo(StateBounds[AImageIndex, AState], SourceParts, AVisibility, False);
    InitializePartsInfo(ARect, DestParts, AVisibility, True);
    for ARow := 0 to 2 do
      for ACol := 0 to 2 do
        if AVisibility[ACol, ARow] then
        begin
          DrawPart(ACanvas, DestParts[ACol, ARow], SourceParts[ACol, ARow],
            PartSizing[ACol, ARow], (ACol = 1) and (ARow = 1));
        end;
  end;
end;

procedure TdxSkinImage.DrawPart(ACanvas: TdxSkinCanvas; const ADest: TRect;
  const ASource: TRect; APartSizing, AIsCenterPart: Boolean); 
begin
  if (GradientBeginColor <> clNone) and AIsCenterPart then
    ACanvas.FillRectByGradient(ADest, GradientBeginColor, GradientEndColor, Gradient)
  else
    if not APartSizing then
      ACanvas.DrawImage(Texture, ADest, ASource)
    else
      if Stretch = smTile then
        ACanvas.TileImage(Texture, ADest, ASource)
      else
        ACanvas.StretchDrawImage(Texture, ADest, ASource);
end;

procedure TdxSkinImage.DoChange;
begin
  IsDirty := True;
  if Assigned(FOnChange) then
    FOnChange(Self);
end;

procedure TdxSkinImage.DoInitializeInfo;
var
  AState: TdxSkinElementState;
  AParts: TdxSkinElementPartBounds;
  AStateIndices: array[TdxSkinElementState] of Byte;
begin
  FStateCount := 0;
  FillChar(AStateIndices, SizeOf(AStateIndices), 0);
  for AState := Low(TdxSkinElementState) to High(TdxSkinElementState) do
    if AState in States then
    begin
      AStateIndices[AState] := FStateCount;
      Inc(FStateCount);
    end;
  FSize := cxSize(Texture.Width, Texture.Height);
  if StateCount > 0 then
  begin
    if ImageLayout = ilHorizontal then
      FSize.cx := FSize.cx div ImageCount div StateCount
    else
      FSize.cy := FSize.cy div ImageCount div StateCount;
  end;
  for AState := Low(TdxSkinElementState) to High(TdxSkinElementState) do
  begin
    if ImageLayout = ilHorizontal then
      FStateBounds[AState] := Rect(AStateIndices[AState] * FSize.cx,
       0, (AStateIndices[AState] + 1) * FSize.cx, FSize.cy)
    else
      FStateBounds[AState] := Rect(0, AStateIndices[AState] * FSize.cy,
       FSize.cx, (AStateIndices[AState] + 1) * FSize.cy)
  end;
  InitializePartsInfo(Rect(0, 0, FSize.cx, FSize.cy), AParts, FPartsVisibility, False);
end;

function TdxSkinImage.GetOwner: TPersistent;
begin
  Result := FOwner;
end;

procedure TdxSkinImage.InitializePartsInfo(const ABounds: TRect;
  var AParts; var AVisibility; ACheckMargins: Boolean);

  procedure MakePart(const ALeft, ATop, ARight, ABottom: Integer;
    var ARect: TRect; var AVisible: Boolean);
  begin
    if not AVisible then Exit;
    ARect.Left := ALeft;
    ARect.Top := ATop;
    ARect.Right := ARight;
    ARect.Bottom := ABottom;
    AVisible := (ALeft < ARight) and (ATop < ABottom);
  end;

  procedure DoCheckMargins(var AMargins: TRect);
  var
    ASize, ADelta, I: Integer;
  begin
    if ACheckMargins then
    begin
      ASize := AMargins.Left + AMargins.Right;
      ADelta := ASize - cxRectWidth(ABounds);
      if ADelta > 0 then
      begin
        for I := 0 to 2 do
        begin
          FPartSizing[0, I] := True;
          FPartSizing[2, I] := True;
        end;
        Dec(AMargins.Left, MulDiv(AMargins.Left, ADelta, ASize));
        Dec(AMargins.Right, MulDiv(AMargins.Right, ADelta, ASize));
      end;
      ASize := AMargins.Top + AMargins.Bottom;
      ADelta := ASize - cxRectHeight(ABounds);
      if ADelta > 0 then
      begin
        Dec(AMargins.Top, MulDiv(AMargins.Top, ADelta, ASize));
        Dec(AMargins.Bottom, MulDiv(AMargins.Bottom, ADelta, ASize));
        for I := 0 to 2 do
        begin
          FPartSizing[I, 0] := True;
          FPartSizing[I, 2] := True;
        end;
      end;
    end;
  end;

var
  AMargins, R: TRect;
begin
  AMargins := Margins.Rect;
  // stretch margins
  Move(dxSkinsCore.PartSizing, FPartSizing, SizeOf(FPartSizing));
  DoCheckMargins(AMargins);
  //
  with AMargins do
  begin
    R := cxRect(ABounds.Left + Left, ABounds.Top + Top,
      ABounds.Right - Right, ABounds.Bottom - Bottom);
    // check horizontal bounds
    if R.Left > ABounds.Right then
      R.Left := ABounds.Right;
    if R.Left > R.Right then
      R.Right := R.Left;
    if R.Right > ABounds.Right then
      R.Right := ABounds.Right;
    // check vertical bounds
    if R.Top > ABounds.Bottom then
      R.Top := ABounds.Bottom;
    if R.Top > R.Bottom then
      R.Bottom := R.Top;
    if R.Bottom > ABounds.Bottom then
      R.Bottom := ABounds.Bottom;
  end;
  // top line
  MakePart(ABounds.Left, ABounds.Top, R.Left, R.Top,
    TdxSkinElementPartBounds(AParts)[0, 0],
    TdxSkinElementPartVisibility(AVisibility)[0, 0]);
  MakePart(R.Left, ABounds.Top, R.Right, R.Top,
    TdxSkinElementPartBounds(AParts)[1, 0],
    TdxSkinElementPartVisibility(AVisibility)[1, 0]);
  MakePart(R.Right, ABounds.Top, ABounds.Right, R.
    Top, TdxSkinElementPartBounds(AParts)[2, 0],
    TdxSkinElementPartVisibility(AVisibility)[2, 0]);
  // middle line
  MakePart(ABounds.Left, R.Top, R.Left, R.Bottom,
    TdxSkinElementPartBounds(AParts)[0, 1],
    TdxSkinElementPartVisibility(AVisibility)[0, 1]);
  MakePart(R.Left, R.Top, R.Right, R.Bottom,
    TdxSkinElementPartBounds(AParts)[1, 1],
    TdxSkinElementPartVisibility(AVisibility)[1, 1]);
  MakePart(R.Right, R.Top, ABounds.Right, R.Bottom,
    TdxSkinElementPartBounds(AParts)[2, 1],
    TdxSkinElementPartVisibility(AVisibility)[2, 1]);
  // bottom line
  MakePart(ABounds.Left, R.Bottom, R.Left, ABounds.Bottom,
    TdxSkinElementPartBounds(AParts)[0, 2],
    TdxSkinElementPartVisibility(AVisibility)[0, 2]);
  MakePart(R.Left, R.Bottom, R.Right, ABounds.Bottom,
    TdxSkinElementPartBounds(AParts)[1, 2],
    TdxSkinElementPartVisibility(AVisibility)[1, 2]);
  MakePart(R.Right, R.Bottom, ABounds.Right, ABounds.Bottom,
    TdxSkinElementPartBounds(AParts)[2, 2],
    TdxSkinElementPartVisibility(AVisibility)[2, 2]);
end;

function TdxSkinImage.GetEmpty: Boolean;
begin
  Result := (FSourceName = '') and Texture.Empty;
end;

function TdxSkinImage.GetImageCount: Integer;
begin
  Result := Owner.ImageCount;
end;

function TdxSkinImage.GetName: string;
begin
  if not Empty then
    Result := Owner.ExpandName(Self)
  else
    Result := '';
end;

function TdxSkinImage.GetPartSizing(Col, Row: Integer): Boolean;
begin
  Result := FPartSizing[Col, Row];
end;

function TdxSkinImage.GetPartVisible(Col, Row: Integer): Boolean;
begin
  Result := FPartsVisibility[Col, Row];
end;

function TdxSkinImage.GetSize: TSize;
begin
  CheckInfo;
  Result := FSize;
end;

function TdxSkinImage.GetSourceName: string;
begin
  Result := FSourceName;
  if (Result = '') and not Empty then
    Result := Owner.Path + Name;
end;

function TdxSkinImage.GetStateBounds(
  AImageIndex: Integer; AState: TdxSkinElementState): TRect;
begin
  CheckInfo;
  Result := FStateBounds[AState];
  if AImageIndex > 0 then
  begin
    if ImageLayout = ilHorizontal then
      OffsetRect(Result, StateCount * AImageIndex * Size.cx, 0)
    else
      OffsetRect(Result, 0, StateCount * AImageIndex * Size.cy)
  end;
end;

function TdxSkinImage.GetStateCount: Integer;
begin
  CheckInfo;
  Result := FStateCount;
end;

procedure TdxSkinImage.ReadData(AStream: TStream);
var
  APos, ASize: Integer;
begin
  AStream.Read(FMargins.Data^, SizeOf(TRect));
  AStream.Read(FImageLayout, SizeOf(TdxSkinImageLayout));
  AStream.Read(FStates, SizeOf(TdxSkinElementStates));
  AStream.Read(FStretch, SizeOf(FStretch));
  if Owner.Group.Skin.Version >= 1.02 then
  begin
    AStream.Read(FGradientBeginColor, SizeOf(FGradientBeginColor));
    AStream.Read(FGradientEndColor, SizeOf(FGradientEndColor));
    AStream.Read(FGradient, SizeOf(FGradient));
  end;
  AStream.Read(ASize, SizeOf(Integer));
  APos := AStream.Position;
  if ASize > 0 then
  begin
    PartStream.InitializeEx(AStream, AStream.Position, AStream.Position + ASize);
    Texture.LoadFromStream(PartStream);
  end;
  AStream.Position := APos + ASize;
  IsDirty := True;
end;

procedure TdxSkinImage.WriteData(AStream: TStream);
var
  ASize: Integer;
  APNGStream: TMemoryStream;
begin
  AStream.Write(Margins.Data^, SizeOf(TRect));
  AStream.Write(FImageLayout, SizeOf(TdxSkinImageLayout));
  AStream.Write(FStates, SizeOf(TdxSkinElementStates));
  AStream.Write(FStretch, SizeOf(FStretch));
  AStream.Write(FGradientBeginColor, SizeOf(FGradientBeginColor));
  AStream.Write(FGradientEndColor, SizeOf(FGradientEndColor));
  AStream.Write(FGradient, SizeOf(FGradient));
  APNGStream := TMemoryStream.Create;
  try
    if not Empty then
      Texture.SaveToStream(APNGStream);
    ASize := APNGStream.Size;
    AStream.Write(ASize, SizeOf(Integer));
    if ASize > 0 then
    begin
      APNGStream.Position := 0;
      AStream.Write(APNGStream.Memory^, APNGStream.Size);
    end;
  finally
    APNGStream.Free;
  end;
end;

procedure TdxSkinImage.SetGradientBeginColor(AValue: TColor);
begin
  if AValue <> FGradientBeginColor then
  begin
    FGradientBeginColor := AValue;
    DoChange;
  end;
end;

procedure TdxSkinImage.SetGradientEndColor(AValue: TColor);
begin
  if AValue <> GradientEndColor then
  begin
    FGradientEndColor := AValue;
    DoChange;
  end;
end;

procedure TdxSkinImage.SetGradientMode(AValue: TdxSkinGradientMode);
begin
  if AValue <> FGradient then