ksskinobjects.pas

来自「小区水费管理系统源代码水费收费管理系统 水费收费管理系统」· PAS 代码 · 共 2,327 行 · 第 1/5 页

  private
    FFontHot: TFont;
    FFontFocused: TFont;
    FFontPressed: TFont;
    FFontDisabled: TFont;
    procedure SetFontHot(const Value: TFont);
    procedure SetFontDisabled(const Value: TFont);
    procedure SetFontFocused(const Value: TFont);
    procedure SetFontPressed(const Value: TFont);
  protected
    function GetFont: TFont; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    { Assign, Copy }
    procedure Assign(Source: TPersistent); override;
    { Drawing }
    procedure Draw(Canvas: TCanvas); override;
    { Colors }
    procedure ChangeHue(DeltaHue: integer); override;
    { Font }
    procedure SetCharset(CharSet: TFontCharset); override;
  published
    property FontHot: TFont read FFontHot write SetFontHot;
    property FontFocused: TFont read FFontFocused write SetFontFocused;
    property FontPressed: TFont read FFontPressed write SetFontPressed;
    property FontDisabled: TFont read FFontDisabled write SetFontDisabled;
  end;

{ Registration }

var
  RegObjects: TList; { registered class }

procedure RegisterSkinObject(ObjectClass: TSeSkinObjectClass);
function GetSkinObjectClass(ClassName: string): TSeSkinObjectClass;

procedure SaveSkinObject(Stream: TStream; SkinObject: TSeSkinObject);
function LoadSkinObject(Stream: TStream; Owner: TSeSkinObject): TSeSkinObject;

procedure SaveSkinObjectBinary(Stream: TStream; SkinObject: TSeSkinObject);
function LoadSkinObjectBinary(Stream: TStream; Owner: TSeSkinObject): TSeSkinObject;

implementation {===============================================================}

uses KsSkinForms;

procedure RegisterSkinObject(ObjectClass: TSeSkinObjectClass);
begin
  if RegObjects = nil then
    RegObjects := TList.Create;
  if RegObjects <> nil then
    RegObjects.Add(ObjectClass);
end;

function GetSkinObjectClass(ClassName: string): TSeSkinObjectClass;
var
  i: integer;
begin
  for i := 0 to RegObjects.Count-1 do
    if TSeSkinObjectClass(RegObjects[i]).ClassName = ClassName then
    begin
      Result := TSeSkinObjectClass(RegObjects[i]);
      Exit;;
    end;

  Result := nil;
end;

{ I/O Routines }

procedure SaveSkinObject(Stream: TStream; SkinObject: TSeSkinObject);
var
  BinStream:TMemoryStream;
  StrStream: TStringStream;
  s: string;
begin
  if SkinObject = nil then Exit;

  BinStream := TMemoryStream.Create;
  try
    StrStream := TStringStream.Create(S);
    try
      BinStream.WriteComponent(SkinObject);
      BinStream.Seek(0, soFromBeginning);
      ObjectBinaryToText(BinStream, StrStream);
      StrStream.Seek(0, soFromBeginning);
      S := StrStream.DataString;
    finally
      StrStream.Free;
    end;
  finally
    BinStream.Free
  end;

  WriteString(Stream, SkinObject.ClassName);
  WriteString(Stream, S);
end;

function LoadSkinObject(Stream: TStream; Owner: TSeSkinObject): TSeSkinObject;
var
  SkinObjectClass: TSeSkinObjectClass;
  S, ClassName: string;
  StrStream:TStringStream;
  BinStream: TMemoryStream;
begin
  Result := nil;

  ClassName := ReadString(Stream);

  { make object }
  SkinObjectClass := GetSkinObjectClass(ClassName);
  if SkinObjectClass <> nil then
    Result := SkinObjectClass.Create(Owner);

  { Load object }
  if Result <> nil then
  begin
    S := ReadString(Stream);
    StrStream := TStringStream.Create(S);
    try
      BinStream := TMemoryStream.Create;
      try
        ObjectTextToBinary(StrStream, BinStream);
        BinStream.Seek(0, soFromBeginning);

        BinStream.ReadComponent(Result);

        { Set Charset }
        Result.SetCharset(DEFAULT_CHARSET);
      finally
        BinStream.Free;
      end;
    finally
      StrStream.Free;
    end;
  end;
end;

procedure SaveSkinObjectBinary(Stream: TStream; SkinObject: TSeSkinObject);
var
  MemStream: TMemoryStream;
  Size: Cardinal;
begin
  WriteString(Stream, SkinObject.ClassName);

  MemStream := TMemoryStream.Create;
  MemStream.WriteComponent(SkinObject);

  Size := MemStream.Size;
  Stream.WriteBuffer(Size, SizeOf(Size));
  Stream.WriteBuffer(MemStream.Memory^, Size);

  MemStream.Free;
end;

function LoadSkinObjectBinary(Stream: TStream; Owner: TSeSkinObject): TSeSkinObject;
var
  SkinObjectClass: TSeSkinObjectClass;
  ClassName: string;
  MemStream: TMemoryStream;
  Size: Cardinal;
begin
  Result := nil;

  ClassName := ReadString(Stream);

  { make object }
  SkinObjectClass := GetSkinObjectClass(ClassName);
  if SkinObjectClass <> nil then
    Result := SkinObjectClass.Create(Owner);

  { Load object }
  if Result <> nil then
  begin
    Stream.ReadBuffer(Size, SizeOf(Size));

    MemStream := TMemoryStream.Create;
    MemStream.SetSize(Size);
    Stream.ReadBuffer(MemStream.Memory^, Size);

    MemStream.ReadComponent(Result);
    MemStream.Free;
    { Set Charset }
    Result.SetCharset(DEFAULT_CHARSET);
  end;
end;

{ TSeSkinObject ===============================================================}

constructor TSeSkinObject.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FEnabled := true;
  FVisible := true;
  FColor := clWhite;
  FFont := TFont.Create;
  FTextAlign := taLeft;
  FMasked := true;
end;

destructor TSeSkinObject.Destroy;
begin
  FFont.Free;
  inherited Destroy;
end;

procedure TSeSkinObject.AfterLoad;
var
  i: integer;
begin
  if Count = 0 then Exit;

  for i := 0 to Count-1 do
    Objects[i].AfterLoad;
end;

{ Protected ===================================================================}

procedure TSeSkinObject.Assign(Source: TPersistent);
var
  i: integer;
  Child: TSeSkinObject;
begin
  if Source is TSeSkinObject then
  begin
    { Assign }
    Name := TSeSkinObject(Source).Name;

    FMasked := TSeSkinObject(Source).FMasked;
    FAlign := TSeSkinObject(Source).FAlign;
    FKind := TSeSkinObject(Source).FKind;
    FAlign := TSeSkinObject(Source).FAlign;
    FBitmaps := TSeSkinObject(Source).FBitmaps;
    FColor := TSeSkinObject(Source).FColor;
    FDrawIfOwner := TSeSkinObject(Source).FDrawIfOwner;
    FFont.Assign(TSeSkinObject(Source).FFont);
    FKind := TSeSkinObject(Source).FKind;
    FTextAlign := TSeSkinObject(Source).FTextAlign;
    FTextEffect := TSeSkinObject(Source).FTextEffect;
    FTextMarginLeft := TSeSkinObject(Source).FTextMarginLeft;
    FTextMarginRight := TSeSkinObject(Source).FTextMarginRight;
    FTextMarginTop := TSeSkinObject(Source).FTextMarginTop;

    FMarginLeft := TSeSkinObject(Source).FMarginLeft;
    FMarginTop := TSeSkinObject(Source).FMarginTop;
    FMarginRight := TSeSkinObject(Source).FMarginRight;
    FMarginBottom := TSeSkinObject(Source).FMarginBottom;

    { Copy Objects }
    for i := 0 to TSeSkinObject(Source).Count - 1 do
    begin
      Child := TSeSkinObject(Source).Objects[i].CreateCopy(Self);
    end;

    { Bounds }
    FLeft := TSeSkinObject(Source).Left;
    FTop := TSeSkinObject(Source).Top;
    FWidth := TSeSkinObject(Source).Width;
    FHeight := TSeSkinObject(Source).Height;
//    BoundsRect := TSeSkinObject(Source).BoundsRect;
  end
  else
    inherited Assign(Source);
end;

function TSeSkinObject.CreateCopy(AOwner: TSeSkinObject): TSeSkinObject;
var
  ClassType: TSeSkinObjectClass;
begin
  ClassType := GetSkinObjectClass(ClassName);
  if ClassType <> nil then
  begin
    Result := ClassType.Create(AOwner);
    Result.Assign(Self);
  end
  else
    Result := nil;
end;

function TSeSkinObject.GetSkinForm: TComponent;
var
  R: Integer;
begin
  Result := nil;

  if FParentControl <> nil then
  begin
    R := SendMessage(FParentControl.Handle, WM_GETSKINFORM, 0, 0);
    if Pointer(R) <> nil then
      Result := TComponent(R);
  end
end;

{ BiDi Mode }

function TSeSkinObject.DrawTextBiDiModeFlags(Flags: Integer): Longint;
begin
  Result := Flags;
  { do not change center alignment }
  if UseRightToLeftAlignment then
    if Result and DT_RIGHT = DT_RIGHT then
      Result := Result and not DT_RIGHT { removing DT_RIGHT, makes it DT_LEFT }
    else if not (Result and DT_CENTER = DT_CENTER) then
      Result := Result or DT_RIGHT;
  Result := Result or DrawTextBiDiModeFlagsReadingOnly;
end;

function TSeSkinObject.DrawTextBiDiModeFlagsReadingOnly: Longint;
begin
  if UseRightToLeftReading then
    Result := DT_RTLREADING
  else
    Result := 0;
end;

function TSeSkinObject.UseRightToLeftAlignment: Boolean;
begin
  Result := SysLocale.MiddleEast and (BiDiMode <> bdLeftToRight);
end;

function TSeSkinObject.UseRightToLeftReading: Boolean;
begin
  Result := SysLocale.MiddleEast and (BiDiMode = bdRightToLeft);
end;

{ Aligning ====================================================================}

procedure TSeSkinObject.Aligning;
var
  i: integer;
  R: TRect;
  Canvas: TCanvas;
begin
  R := BoundsRect;
  { most top & most bottom align }
  for i := 0 to Count-1 do
  begin
    if (Objects[i].Align = saMostTop) and (Objects[i].FVisible) then
    with Objects[i] do
    begin
      BoundsRect := Rect(R.Left, R.Top, R.Right, R.Top+Height);
      Inc(R.Top, Height);
    end;
    if (Objects[i].Align = saMostBottom) and (Objects[i].FVisible) then
    with Objects[i] do
    begin
      BoundsRect := Rect(R.Left, R.Bottom-Height, R.Right, R.Bottom);
      Dec(R.Bottom, Height);
    end;
  end;
  { most left & right align }
  for i := 0 to Count-1 do
  begin
    if (Objects[i].Align = saMostLeft) and (Objects[i].FVisible) then
    with Objects[i] do
    begin
      BoundsRect := Rect(R.Left, R.Top, R.Left+Width, R.Bottom);
      Inc(R.Left, Width);
    end;
    if (Objects[i].Align = saMostRight) and (Objects[i].FVisible) then
    with Objects[i] do
    begin
      BoundsRect := Rect(R.Right-Width, R.Top, R.Right, R.Bottom);
      Dec(R.Right, Width);
    end;
  end;
  { top & bottom align }
  for i := 0 to Count-1 do
  begin
    if (Objects[i].Align = saTop) and (Objects[i].FVisible) then
    with Objects[i] do
    begin
      BoundsRect := Rect(R.Left, R.Top, R.Right, R.Top+Height);
      Inc(R.Top, Height);
    end;
    if (Objects[i].Align = saBottom) and (Objects[i].FVisible) then
    with Objects[i] do
    begin
      BoundsRect := Rect(R.Left, R.Bottom-Height, R.Right, R.Bottom);
      Dec(R.Bottom, Height);
    end;
  end;
  { left & right align }
  for i := 0 to Count-1 do
  begin
    if (Objects[i].Align = saLeft) and (Objects[i].FVisible) then
    with Objects[i] do
    begin
      BoundsRect := Rect(R.Left, R.Top, R.Left+Width, R.Bottom);
      Inc(R.Left, Width);
    end;
    if (Objects[i].Align = saRight) and (Objects[i].FVisible) then
    with Objects[i] do
    begin
      BoundsRect := Rect(R.Right-Width, R.Top, R.Right, R.Bottom);
      Dec(R.Right, Width);
    end;
  end;
  { text align }
  for i := Count-1 Downto 0 do
    if (Objects[i].FVisible) and (Objects[i].Align = saText) then
    with Objects[i] do
    begin
       Canvas := TCanvas.Create;
       Canvas.Handle := GetDC(0);

       Canvas.Font := Font;
       Width := TextMarginLeft + TextMarginRight + TextWidth(Canvas, FText);

       ReleaseDC(0, Canvas.Handle);
       Canvas.Handle := 0;
       Canvas.Free;
    end;
  { center align }
  for i := Count-1 Downto 0 do
    if (Objects[i].Align = saCenter) and (Objects[i].FVisible) then
    with Objects[i] do
    begin
      BoundsRect := Rect(R.Left + (R.Right-R.left-Width) div 2,
        R.Top + (R.Bottom-R.Top-Height) div 2,
        R.Left + (R.Right-R.Left-Width) div 2 + FWidth,
        R.Top + (R.Bottom-R.Top-Height) div 2 + FHeight);
    end;
  { client align }
  for i := 0 to Count-1 do
    if (Objects[i].Align = saClient) and (Objects[i].FVisible) then
      Objects[i].BoundsRect := Rect(R.Left, R.Top, R.Right, R.Bottom);
  { other align }
  for i := 0 to Count-1 do
  begin
    if (Objects[i].Align = saTopRight) and (FOldWidth > 0) then
      Objects[i].FLeft := FWidth - (FOldWidth - Objects[i].FLeft);
    if Objects[i].Align = saBottomLeft then
      Objects[i].FTop := FHeight - (FOldHeight - Objects[i].FTop);
    if Objects[i].Align = saBottomRight then
    begin
      Objects[i].FLeft := FWidth - Objects[i].FLeft;
      Objects[i].FTop := FHeight - Objects[i].FTop;
    end;
  end;
end;

procedure TSeSkinObject.Invalidate;
begin
  if not Visible then Exit;

  if FParentControl <> nil then
    SendMessage(FParentControl.Handle, WM_INVALIDATESKINOBJECT, 0, Integer(Self));
end;

{ Drawing =====================================================================}

procedure TSeSkinObject.Draw(Canvas: TCanvas);
var
  i: integer;
  Child: TSeSkinObject;
begin
  if not Visible then Exit;
  if FWidth <= 0 then Exit;
  if FHeight <= 0 then Exit;

  if (Count = 0) or ((Count > 0) and (FDrawIfOwner)) then
  begin
    if FColor = clNone then
    begin