ksskinobjects.pas

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

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

procedure TSeSkinObject.SetParentControl(const Value: TWinControl);
var
  i: integer;
begin
  FParentControl := Value;

  if FParentControl <> nil then
    BiDiMode := FParentControl.BiDiMode;
    
  if Count = 0 then Exit;

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

procedure TSeSkinObject.SetState(const Value: TSeState);
var
  i: integer;
begin
  begin
    FState := Value;

    if Count = 0 then Exit;

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

procedure TSeSkinObject.SetMarginBottom(const Value: integer);
begin
  FMarginBottom := Value;
end;

procedure TSeSkinObject.SetMarginLeft(const Value: integer);
begin
  FMarginLeft := Value;
end;

procedure TSeSkinObject.SetMarginRight(const Value: integer);
begin
  FMarginRight := Value;
end;

procedure TSeSkinObject.SetMarginTop(const Value: integer);
begin
  FMarginTop := Value;
end;



{ TSeActiveObject =========================================================}



constructor TSeActiveObject.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FActiveFont := TFont.Create;
end;

destructor TSeActiveObject.Destroy;
begin
  FActiveFont.Free;
  inherited Destroy;
end;

procedure TSeActiveObject.Assign(Source: TPersistent);
begin
  if Source is TSeActiveObject then
  begin
    inherited Assign(Source);
    ActiveColor := (Source as TSeActiveObject).ActiveColor;
    ActiveFont := (Source as TSeActiveObject).ActiveFont;
  end
  else
    inherited;
end;

procedure TSeActiveObject.SetCharset(CharSet: TFontCharset);
begin
  inherited;
  FActiveFont.Charset := CharSet;
end;

procedure TSeActiveObject.ChangeHue(DeltaHue: integer);
begin
  inherited;
  if FActiveColor <> clNone then
    FActiveColor := KColorToColor(se_controls.ChangeHue(KColor(FActiveColor), DeltaHue));
  FActiveFont.Color := KColorToColor(se_controls.ChangeHue(KColor(FActiveFont.Color), DeltaHue));
end;

function TSeActiveObject.GetFont: TFont;
begin
  case FState of
    ssHot, ssFocused, ssPressed: Result := FActiveFont;
  else
    Result := inherited GetFont;
  end;
end;

procedure TSeActiveObject.Draw(Canvas: TCanvas);
var
  SaveColor: TColor;
  SaveFont: TFont;
begin
  if FWidth <= 0 then Exit;
  if FHeight <= 0 then Exit;

  if (FActive) or (FState in [ssFocused, ssHot, ssPressed]) then
  begin
    SaveFont := FFont;
    SaveColor := FColor;
    try
      FColor := FActiveColor;
      FFont := FActiveFont;
      inherited Draw(Canvas);
    finally
      FFont := SaveFont;
      FColor := SaveColor;
    end;
  end
  else
    inherited Draw(Canvas);
end;

procedure TSeActiveObject.SetActiveFont(const Value: TFont);
begin
  FActiveFont.Assign(Value);
end;



{ TSeBitmapObject =========================================================}



constructor TSeBitmapObject.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FBitmap := TSeBitmapLink.Create;
  FMaskedAngles := true;
  FMaskedBorder := true;
end;

destructor TSeBitmapObject.Destroy;
begin
  FBitmap.Free;
  inherited Destroy;
end;

procedure TSeBitmapObject.AfterLoad;
var
  NewLink: TSeBitmapLink;
begin
  inherited AfterLoad;
  if FBitmaps <> nil then
  begin
    NewLink := FBitmaps.GetBitmapLink(FBitmap.Name, FBitmap.Rect);
    if NewLink <> nil then
    begin
      FBitmap.Free;
      FBitmap := NewLink;
    end;
  end;
end;

procedure TSeBitmapObject.Assign(Source: TPersistent);
begin
  if Source is TSeBitmapObject then
  begin
    inherited Assign(Source);
    Bitmap := (Source as TSeBitmapObject).Bitmap;
    FTileStyle := (Source as TSeBitmapObject).FTileStyle;
    BorderTileStyle := (Source as TSeBitmapObject).FBorderTileStyle;
    MaskedBorder := (Source as TSeBitmapObject).MaskedBorder;
    MaskedAngles := (Source as TSeBitmapObject).MaskedAngles;
  end
  else
    inherited;
end;

procedure TSeBitmapObject.DrawRect(Canvas: TCanvas; MarginRect, MarginDstRect: TRect;
  ATileStyle: TscTileStyle; AMasked: boolean);
var
  DstRect, R: TRect;
  i, j: integer;
  W, H: integer;
  DW, DH: integer;
begin
  W := RectWidth(MarginRect);
  H := RectHeight(MarginRect);
  if W * H = 0 then Exit;

  case ATileStyle of
    tsTile: begin
      OffsetRect(MarginDstRect, Left, Top);
      if AMasked then
        FBitmap.Bitmap.DrawTile(Canvas, MarginDstRect, MarginRect, true)
      else
        FBitmap.Bitmap.DrawTileDDB(Canvas.Handle, MarginDstRect, MarginRect);
    end;
    tsStretch: begin
      OffsetRect(MarginDstRect, Left, Top);
      if AMasked then
        FBitmap.Bitmap.Draw(Canvas, MarginDstRect, MarginRect, true)
      else
        FBitmap.Bitmap.DrawDDB(Canvas.Handle, MarginDstRect, MarginRect);
    end;
    tsCenter: begin
      R := BoundsRect;
      if AMasked then
        FBitmap.Bitmap.Draw(Canvas, Left + (Width - RectWidth(R)) div 2,
          Top + (Height - RectHeight(R)) div 2, MarginRect, true)
      else
        FBitmap.Bitmap.DrawDDB(Canvas.Handle, Left + (Width - RectWidth(R)) div 2,
          Top + (Height - RectHeight(R)) div 2, MarginRect);
    end;
  end;
end;

procedure TSeBitmapObject.DrawNormal(Canvas: TCanvas);
var
  DstRect, R: TRect;
  i, j: integer;
  W, H: integer;
  DW, DH: integer;
begin
  if not FBitmap.Assigned then
  begin
    inherited Draw(Canvas);
    Exit;
  end;

  if FWidth <= 0 then Exit;
  if FHeight <= 0 then Exit;

  case FTileStyle of
    tsTile: begin
      if FMasked then
        FBitmap.Bitmap.DrawTile(Canvas, BoundsRect, FBitmap.Rect, FMasked)
      else
        FBitmap.Bitmap.DrawTileDDB(Canvas.Handle, BoundsRect, FBitmap.Rect)
    end;
    tsStretch: begin
      if FMasked then
        FBitmap.Bitmap.Draw(Canvas, BoundsRect, FBitmap.Rect, FMasked)
      else
        FBitmap.Bitmap.DrawDDB(Canvas.Handle, BoundsRect, FBitmap.Rect);
    end;
    tsCenter: begin
      R := FBitmap.Rect;
      if FMasked then
        FBitmap.Bitmap.Draw(Canvas, Left + (Width - RectWidth(R)) div 2,
          Top + (Height - RectHeight(R)) div 2, FBitmap.Rect, FMasked)
      else
        FBitmap.Bitmap.DrawDDB(Canvas.Handle, Left + (Width - RectWidth(R)) div 2,
          Top + (Height - RectHeight(R)) div 2, FBitmap.Rect);
    end;
  end;

  DrawObjectText(Canvas);
  Aligning;
  DrawChild(Canvas);
end;

procedure TSeBitmapObject.Draw(Canvas: TCanvas);
var
  SrcRect, DstRect: TRect;
begin
  if not FBitmap.Assigned then Exit;
  if FWidth <= 0 then Exit;
  if FHeight <= 0 then Exit;

  if (MarginLeft = 0) and (MarginTop = 0) and
     (MarginRight = 0) and (MarginBottom = 0) then
  begin
    DrawNormal(Canvas);
    Exit;
  end;

  { Draw Face }

  { Draw Center Rect }
  with FBitmap.Rect do
    SrcRect := Rect(Left + FMarginLeft, Top + FMarginTop, Right - FMarginRight,
      Bottom - FMarginBottom);
  DstRect := Rect(FMarginLeft, FMarginTop, FWidth - FMarginRight, FHeight - FMarginBottom);
  DrawRect(Canvas, SrcRect, DstRect, FTileStyle, FMasked);

  { Draw Top Border }
  with FBitmap.Rect do
    SrcRect := Rect(Left + FMarginLeft, Top, Right - FMarginRight,
      Top + FMarginTop);
  DstRect := Rect(FMarginLeft, 0, FWidth - FMarginRight, FMarginTop);
  DrawRect(Canvas, SrcRect, DstRect, FBorderTileStyle, FMaskedBorder);

  { Draw Bottom Border }
  with FBitmap.Rect do
    SrcRect := Rect(Left + FMarginLeft, Bottom - FMarginBottom, Right - FMarginRight,
      Bottom);
  DstRect := Rect(FMarginLeft, FHeight - FMarginBottom, FWidth - FMarginRight, FHeight);
  DrawRect(Canvas, SrcRect, DstRect, FBorderTileStyle, FMaskedBorder);

  { Draw Left Border }
  with FBitmap.Rect do
    SrcRect := Rect(Left, Top + FMarginTop, Left + FMarginLeft,
      Bottom - FMarginBottom);
  DstRect := Rect(0, FMarginTop, FMarginLeft, FHeight - FMarginBottom);
  DrawRect(Canvas, SrcRect, DstRect, FBorderTileStyle, FMaskedBorder);

  { Draw Right Border }
  with FBitmap.Rect do
    SrcRect := Rect(Right - FMarginRight, Top + FMarginTop, Right,
      Bottom - FMarginBottom);
  DstRect := Rect(FWidth - FMarginRight, FMarginTop, FWidth,
    FHeight - FMarginBottom);
  DrawRect(Canvas, SrcRect, DstRect, FBorderTileStyle, FMaskedBorder);

  { Draw Angles }
  with FBitmap.Rect do
    SrcRect := Rect(Left, Top, Left + FMarginLeft, Top + FMarginTop);
  if FMaskedAngles then
    FBitmap.Bitmap.Draw(Canvas, Left, Top, SrcRect, true)
  else
    FBitmap.Bitmap.DrawDDB(Canvas.Handle, Left, Top, SrcRect);

  with FBitmap.Rect do
    SrcRect := Rect(Right - FMarginRight, Top, Right, Top + FMarginTop);
  if FMaskedAngles then
    FBitmap.Bitmap.Draw(Canvas, Left + FWidth - FMarginRight, Top, SrcRect, true)
  else
    FBitmap.Bitmap.DrawDDB(Canvas.Handle, Left + FWidth - FMarginRight, Top, SrcRect);

  with FBitmap.Rect do
    SrcRect := Rect(Left, Bottom - FMarginBottom, Left + FMarginLeft, Bottom);
  if FMaskedAngles then
    FBitmap.Bitmap.Draw(Canvas, Left, Top + FHeight - FMarginBottom, SrcRect, true)
  else
    FBitmap.Bitmap.DrawDDB(Canvas.Handle, Left, Top + FHeight - FMarginBottom, SrcRect);

  with FBitmap.Rect do
    SrcRect := Rect(Right - FMarginRight, Bottom - FMarginBottom, Right, Bottom);
  if FMaskedAngles then
    FBitmap.Bitmap.Draw(Canvas, Left + FWidth - FMarginRight,
      Top + FHeight - FMarginBottom, SrcRect, true)
  else
    FBitmap.Bitmap.DrawDDB(Canvas.Handle, Left + FWidth - FMarginRight,
      Top + FHeight - FMarginBottom, SrcRect);

  { Draw Text }
  DrawObjectText(Canvas);
  Aligning;
  DrawChild(Canvas);
end;

function TSeBitmapObject.CreateRegion: HRgn;
var
  TempImage: TSeBitmap;
  TempCanvas: TCanvas;
  SaveRect: TRect;
begin
  if not FBitmap.Assigned then Exit;
  if FWidth <= 0 then Exit;
  if FHeight <= 0 then Exit;
  if (FKind = skClient) or (not FMasked) then
  begin
    Result := CreateRectRgn(FLeft, FTop, FLeft + FWidth, FTop + FHeight);
    Exit;
  end;

  { Make mask from bitmap }
  SaveRect := BoundsRect;
  try
    { Set new rect }
    BoundsRect := Rect(0, 0, FWidth, FHeight);
    { Draw to TempImage }
    TempImage := TSeBitmap.Create;
    try
      TempImage.SetSize(FWidth, FHeight);
      TempImage.Clear(ckTransparent);
      { Draw to Temp }
      TempCanvas := TCanvas.Create;
      TempCanvas.Handle := TempImage.DC;
      Draw(TempCanvas);
      TempCanvas.Handle := 0;
      TempCanvas.Free;
      { Create region }
      Result := CreateRegionFromBitmap(TempImage, SaveRect.Left, SaveRect.Top);
    finally
      TempImage.Free;
    end;
  finally
    BoundsRect := SaveRect;
  end;
end;

procedure TSeBitmapObject.SetBitmap(const Value: TSeBitmapLink);
begin
  FBitmap.Assign(Value);
end;

procedure TSeBitmapObject.SetBorderTileStyle(const Value: TscTileStyle);
begin
  FBorderTileStyle := Value;
end;



{ TSeActiveBitmap =============================================================}



constructor TSeActiveBitmap.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FActiveBitmap := TSeBitmapLink.Create;
  FActiveFont := TFont.Create;
end;

destructor TSeActiveBitmap.Destroy;
begin
  FActiveFont.Free;
  FActiveBitmap.Free;
  inherited Destroy;
end;

procedure TSeActiveBitmap.AfterLoad;
var
  NewLink: TSeBitmapLink;
begin
  inherited AfterLoad;
  if FBitmaps <> nil then
  begin
    NewLink := FBitmaps.GetBitmapLink(FActiveBitmap.Name, FActiveBitmap.Rect);
    if NewLink <> nil then
    begin
      FActiveBitmap.Free;
      FActiveBitmap := NewLink;
    end;
  end;
end;

procedure TSeActiveBitmap.Assign(Source: TPersistent);
begin
  if Source is TSeActiveBitmap then
  begin
    inherited Assign(Source);
    ActiveBitmap := (Source as TSeActiveBitmap).ActiveBitmap;
    ActiveFont := (Source as TSeActiveBitmap).ActiveFont;
  end
  else
    inherited;
end;

procedure TSeActiveBitmap.SetCharset(CharSet: TFontCharset);
begin
  inherited;
  FActiveFont.Charset := CharSet;
end;