ksskinobjects.pas

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

      if DesignMode then
        FillRect(Canvas, BoundsRect, KColorToColor(ckTransparent));
    end
    else
      FillRect(Canvas, BoundsRect, FColor);
      
    DrawObjectText(Canvas);
  end;

  DrawChild(Canvas);
end;

procedure TSeSkinObject.DrawChild(Canvas: TCanvas);
var
  Child: TSeSkinObject;
  i: integer;
begin
  if Count > 0 then
  begin
    { Draw childs }
    for i := 0 to Count-1 do
    begin
      Child := Objects[i];
      if (Child.Visible) and (Child.Width > 0) and (Child.Height > 0) then
      begin
        Child.Draw(Canvas);
      end;
    end;
  end;
end;

procedure TSeSkinObject.DrawObjectText(Canvas: TCanvas);
var
  SaveColor: TColor;
  Flags: integer;
  R: TRect;
  S: WideString;
begin
  if FText = WideChar('-') then
  begin
    { Separator }
    R := BoundsRect;
    InflateRect(R, -3, -(RectHeight(R) div 2 - 1));
    R.Bottom := R.Top + 1;
    FillRect(Canvas, R, GetFont.Color);

    Exit;
  end;
  { Draw text }
  if FText <> '' then
  begin
    case FTextAlign of
      taTopLeft: Flags := DT_SINGLELINE or DT_TOP or DT_LEFT;
      taTopCenter: Flags := DT_SINGLELINE or DT_TOP or DT_CENTER;
      taTopRight: Flags := DT_SINGLELINE or DT_TOP or DT_RIGHT;
      taLeft: Flags := DT_SINGLELINE or DT_VCENTER or DT_LEFT;
      taCenter: Flags := DT_SINGLELINE or DT_VCENTER or DT_CENTER;
      taRight: Flags := DT_SINGLELINE or DT_VCENTER or DT_RIGHT;
      taBottomLeft: Flags := DT_SINGLELINE or DT_BOTTOM or DT_LEFT;
      taBottomCenter: Flags := DT_SINGLELINE or DT_BOTTOM or DT_CENTER;
      taBottomRight: Flags := DT_SINGLELINE or DT_BOTTOM or DT_RIGHT;
    else
      Flags := DT_SINGLELINE or DT_CENTER or DT_VCENTER;
    end;
    R := BoundsRect;
    Inc(R.Left, FTextMarginLeft);
    Dec(R.Right, FTextMarginRight);
    Inc(R.Top, FTextMarginTop);
    { Set font }
    Canvas.Font := FFont;
    if not FEnabled then
      Canvas.Font.Color := clGray;
    { Set text }
    if FKind = skTitle then
      S := FormatStr(Canvas.Handle, FText, FWidth - FTextMarginLeft - FTextMarginRight)
    else
      S := FText;

    Flags := DrawTextBiDiModeFlags(Flags);

    { Draw text }
    case FTextEffect of
      teNone: DrawText(Canvas, S, R, Flags);
      teShadow: begin
        { Draw shadow }
        SaveColor := Canvas.Font.Color;
        Canvas.Font.Color := clBlack;
        OffsetRect(R, 1, 1);
        DrawText(Canvas, S, R, Flags);
        { Draw text }
        Canvas.Font.Color := SaveColor;
        OffsetRect(R, -1, -1);
        DrawText(Canvas, S, R, Flags);
      end;
    end;
  end;

  if FRightText <> '' then
  begin
    { Draw FRightText }
    case FTextAlign of
      taTopLeft: Flags := DT_SINGLELINE or DT_TOP or DT_RIGHT;
      taTopCenter: Flags := DT_SINGLELINE or DT_TOP or DT_CENTER;
      taTopRight: Flags := DT_SINGLELINE or DT_TOP or DT_LEFT;
      taLeft: Flags := DT_SINGLELINE or DT_VCENTER or DT_RIGHT;
      taCenter: Flags := DT_SINGLELINE or DT_VCENTER or DT_CENTER;
      taRight: Flags := DT_SINGLELINE or DT_VCENTER or DT_LEFT;
      taBottomLeft: Flags := DT_SINGLELINE or DT_BOTTOM or DT_RIGHT;
      taBottomCenter: Flags := DT_SINGLELINE or DT_BOTTOM or DT_CENTER;
      taBottomRight: Flags := DT_SINGLELINE or DT_BOTTOM or DT_LEFT;
    else
      Flags := DT_SINGLELINE or DT_CENTER or DT_VCENTER;
    end;
    R := BoundsRect;
    Inc(R.Left, FTextMarginLeft);
    Dec(R.Right, FTextMarginRight);
    Inc(R.Top, FTextMarginTop);

    if FParentControl <> nil then
      Flags := FParentControl.DrawTextBiDiModeFlags(Flags);

    DrawText(Canvas, FRightText, R, Flags)
  end;
end;

{ Font }

function TSeSkinObject.GetFont: TFont;
begin
  Result := FFont;
end;

{ Colors }

procedure TSeSkinObject.ChangeHue(DeltaHue: integer);
var
  i: integer;
begin
  if FColor <> clNone then
    FColor := KColorToColor(se_controls.ChangeHue(KColor(FColor), DeltaHue));
  if FFont.Color <> clNone then
    FFont.Color := KColorToColor(se_controls.ChangeHue(KColor(FFont.Color), DeltaHue));

  if Count > 0 then
    for i := 0 to Count - 1 do
      Objects[i].ChangeHue(DeltaHue);
end;

{ Region ======================================================================}

function TSeSkinObject.GetRegion: HRgn;
var
  i: integer;
  ChildMask: HRgn;
  AllChildMask: HRgn;
begin
  if (FWidth <= 0) or (FHeight <= 0) then
  begin
    Result := 0;
    Exit;
  end;

  { Add child mask }
  if Count > 0 then
  begin
    if DrawIfOwner or not FMasked then
    begin
      Result := CreateRegion;
      Exit;
    end;

    Result := CreateRectRgn(0, 0, 0, 0);

    for i := 0 to Count-1 do
    begin
      if not Objects[i].Visible then Continue;

      ChildMask := Objects[i].GetRegion;
      if ChildMask <> 0 then
      begin
        CombineRgn(Result, Result, ChildMask, RGN_OR);
        DeleteObject(ChildMask);
      end;
    end;
  end
  else
    Result := CreateRegion;
end;

function TSeSkinObject.CreateRegion: HRgn;
begin
  Result := CreateRectRgn(FLeft, FTop, FLeft + FWidth, FTop + FHeight);
end;

{ Events ======================================================================}

procedure TSeSkinObject.MouseHover;
begin
end;

procedure TSeSkinObject.MouseLeave;
begin
end;

procedure TSeSkinObject.MouseDouble(Button: TMouseButton; X, Y: integer);
begin

end;

procedure TSeSkinObject.MouseDown(Button: TMouseButton; X, Y: integer);
begin

end;

procedure TSeSkinObject.MouseMove(Shift: TShiftState; X, Y: integer);
begin

end;

procedure TSeSkinObject.MouseUp(Button: TMouseButton; X, Y: integer);
begin

end;

{ Children ====================================================================}

procedure TSeSkinObject.SetCharset(CharSet: TFontCharset);
var
  i: integer;
begin
  Font.Charset := CharSet;

  if Count > 0 then
    for i := 0 to Count - 1 do
      Objects[i].SetCharSet(CharSet);
end;

procedure TSeSkinObject.Add(SkinObject: TSeSkinObject);
begin
  InsertComponent(SkinObject);
end;

procedure TSeSkinObject.Remove(SkinObject: TSeSkinObject);
begin
  RemoveComponent(SkinObject);
end;

function TSeSkinObject.FindObjectByKind(AKind: TSeKind): TSeSkinObject;
var
  i: integer;
begin
  Result := nil;
  if FKind = AKind then
  begin
    Result := Self;
    Exit;
  end;
  if Count = 0 then Exit;
  for i := 0 to Count-1 do
  begin
    Result := Objects[i].FindObjectByKind(AKind);
    if Result <> nil then
      Break;
  end;
end;

function TSeSkinObject.FindObjectByName(AName: string): TSeSkinObject;
var
  i: integer;
begin
  Result := nil;
  if LowerCase(Name) = LowerCase(AName) then
  begin
    Result := Self;
    Exit;
  end;
  if Count = 0 then Exit;
  for i := 0 to Count-1 do
  begin
    Result := Objects[i].FindObjectByName(AName);
    if Result <> nil then
      Break;
  end;
end;

function TSeSkinObject.FindObjectByPoint(Point: TPoint): TSeSkinObject;
var
  i: integer;
  SkinObject: TSeSkinObject;
begin
  Result := nil;
  if not FVisible then
    Exit;
  if not PtInRect(BoundsRect, Point) then
    Exit;
  if (FKind = skTranparent) and not DesignMode then
    Exit;

  if Count = 0 then
  begin
    if PtInRect(BoundsRect, Point) then
      Result := Self;
  end
  else
  begin
    for i := 0 to Count-1 do
    begin
      SkinObject := Objects[i].FindObjectByPoint(Point);
      if SkinObject <> nil then
      begin
        Result := SkinObject;
      end;
    end;
    if Result = nil then
      Result := Self;
  end;
end;

{ Custom property =============================================================}

procedure TSeSkinObject.DefineProperties(Filer: TFiler);
begin
  inherited;
  Filer.DefineBinaryProperty('Objects', ReadData, WriteData, true);
end;

const NewFormatFlag = $F0000;

procedure TSeSkinObject.ReadData(Stream: TStream);
var
  i, Count: integer;
begin
  { Load Count }
  Stream.Read(Count, SizeOf(Integer));

  { Load Objects }
  if Count and NewFormatFlag = NewFormatFlag then
  begin
    { New format }
    Count := Count and not NewFormatFlag;
    for i := 0 to Count-1 do
      LoadSkinObjectBinary(Stream, Self);
  end
  else
  begin
    { Old format }
    for i := 0 to Count-1 do
      LoadSkinObject(Stream, Self);
  end;
end;

procedure TSeSkinObject.WriteData(Stream: TStream);
var
  i, Count, SCount: integer;
begin
  Count := GetCount;
  { Save Count }
  SCount := Count or NewFormatFlag;
  Stream.Write(SCount, SizeOf(Integer));
  { Load Objects }
  for i := 0 to Count-1 do
    SaveSkinObjectBinary(Stream, Objects[i]);
end;

{ Properties ==================================================================}

procedure TSeSkinObject.SetBoundsRect(const Value: TRect);
begin
  if (not DesignMode) and (Value.Left = FLeft) and (Value.Top = FTop) and (Value.Right = FLeft + FWidth) and
     (Value.Bottom = FTop + FHeight)
  then
  begin
    FOldWidth := FOldWidth;
    Exit;
  end;

  FOldWidth := FWidth;
  FOldHeight := FHeight;

  FLeft := Value.Left;
  FTop := Value.Top;
  FWidth := Value.Right - Value.Left;
  FHeight := Value.Bottom - Value.Top;
  if FWidth < 0 then FWidth := 0;
  if FHeight < 0 then FHeight := 0;

  Aligning;
end;

function TSeSkinObject.GetCount: integer;
begin
  Result := ComponentCount;
end;

function TSeSkinObject.GetObject(index: integer): TSeSkinObject;
begin
  if (index >= 0) and (index < Count) then
    Result := TSeSkinObject(Components[index])
  else
    Result := nil;
end;

function TSeSkinObject.GetBoundsRect: TRect;
begin
  Result := Rect(FLeft, FTop, FLeft + FWidth, FTop + FHeight);
end;

procedure TSeSkinObject.SetHeight(const Value: integer);
begin
  BoundsRect := Rect(FLeft, FTop, FLeft + FWidth, FTop + Value);
end;

procedure TSeSkinObject.SetWidth(const Value: integer);
begin
  BoundsRect := Rect(FLeft, FTop, FLeft + Value, FTop + FHeight);
end;

procedure TSeSkinObject.SetLeft(const Value: integer);
begin
  BoundsRect := Rect(Value, FTop, Value + FWidth, FTop + FHeight);
end;

procedure TSeSkinObject.SetTop(const Value: integer);
begin
  BoundsRect := Rect(FLeft, Value, FLeft + FWidth, Value + FHeight);
end;

procedure TSeSkinObject.SetBitmaps(const Value: TSeBitmapList);
var
  i: integer;
begin
  FBitmaps := Value;

  if Count = 0 then Exit;

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

procedure TSeSkinObject.SetBiDiMode(const Value: TBiDiMode);
var
  i: integer;
begin
  FBiDiMode := Value;

  if Count = 0 then Exit;

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

procedure TSeSkinObject.SetFont(const Value: TFont);
begin
  FFont.Assign(Value);
end;

procedure TSeSkinObject.SetActive(const Value: boolean);
var
  i: integer;
begin
  if FActive <> Value then
  begin
    FActive := Value;

    if Count = 0 then Exit;