skinexctrls.pas

DynamicSkinForm.v9.15.For.Delphi.BCB 很好的皮肤控件

procedure TspSkinWaveLabel.WMMOVE;
begin
  inherited;
  if not AlphaBlend then RePaint;
end;

procedure TspSkinWaveLabel.Paint;
var
  MaskBuffer: TBitMap;
  FXMaskBuffer: TspEffectBmp;
  TX, TY: Integer;
  ParentImage: TBitMap;
  FXBuffer: TspEffectBmp;
  C: TColor;
begin
  if (Width < 1) or (Height < 1) then Exit;
  // create mask
  MaskBuffer := TBitMap.Create;
  MaskBuffer.Width := Width;
  MaskBuffer.Height := Height;
  with MaskBuffer.Canvas do
  begin
    Brush.Color := clWhite;
    FillRect(Rect(0, 0, Width, Height));
    Font.Assign(Self.Font);
    Font.Color := clBlack;
    case Alignment of
      taLeftJustify: TX := 10;
      taCenter:  TX := Width div 2 - TextWidth(Caption) div 2;
      taRightJustify: TX := Width - 10 - TextWidth(Caption);
    end;
    TY := Height div 2 - TextHeight(Caption) div 2;
    if TX < 0 then TX := 0;
    if TY < 0 then TY := 0;
    Canvas.Brush.Style := bsClear;
    TextOut(TX, TY, Caption);
  end;
  FXMaskBuffer := TspEffectBmp.CreateFromhWnd(MaskBuffer.Handle);
  MaskBuffer.Free;
  // create parent image
  ParentImage := TBitMap.Create;
  ParentImage.Width := Width;
  ParentImage.Height := Height;
  GetParentImage(Self, ParentImage.Canvas);
  FXBuffer := TspEffectBmp.CreateFromhWnd(ParentImage.Handle);
  ParentImage.Free;
  // add effects
  FXMaskBuffer.Wave(FXDiv, FYDiv, FRatioVal);
  //
  GetSkinData;
  if FUseSkinColor and (SkinData <> nil) and (not SkinData.Empty) and (FIndex <> -1)
  then
    begin
      if TspDataSkinControl(FSD.CtrlList.Items[FIndex]) is TspDataSkinStdLabelControl
      then
        C := TspDataSkinStdLabelControl(FSD.CtrlList.Items[FIndex]).FontColor
      else
        C := Font.Color;
     end
  else
    C := Font.Color;
  //
  if FAlphaBlend
  then
    FXBuffer.MaskFillColor(FXMaskBuffer, C, FAlphaBlendValue / 255)
  else
    FXBuffer.MaskFillColor(FXMaskBuffer, C, 1);
  if FAntialiasing
  then
    FXBuffer.MaskAntialiasing(FXMaskBuffer, 1);
  FXBuffer.Draw(Canvas.Handle, 0, 0);
  //
  FXBuffer.Free;
  FXMaskBuffer.Free;
end;

procedure TspSkinWaveLabel.CMTextChanged;
begin
  inherited;
  RePaint;
end;

procedure TspSkinWaveLabel.SetXDiv;
begin
  FXDiv := Value;
  RePaint;
end;

procedure TspSkinWaveLabel.SetYDiv;
begin
  FYDiv := Value;
  RePaint;
end;


procedure TspSkinWaveLabel.SetRatioVal;
begin
  FRatioVal := Value;
  RePaint;
end;

procedure TspSkinWaveLabel.SetAntialiasing;
begin
  FAntialiasing := Value;
  RePaint;
end;

procedure TspSkinWaveLabel.SetAlignment(Value: TAlignment);
begin
  FAlignment := Value;
  RePaint;
end;

{ TspSkinShadowLabel }

constructor TspSkinShadowLabel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle + [csReplicatable, csOpaque];
  FSkinDataName := 'stdlabel';
  Width := 65;
  Height := 17;
  FAutoSize := True;
  FShowAccelChar := True;
  FUseSkinColor := True;
  //
  Font.Name := 'Arial';
  Font.Height := 16;
  Font.Style := [fsBold];
  //
end;

function TspSkinShadowLabel.GetLabelText: string;
begin
  Result := Caption;
end;

procedure TspSkinShadowLabel.WMMOVE;
begin
  inherited;
  if not AlphaBlend then RePaint;
end;

procedure TspSkinShadowLabel.DoDrawText(Cnvs: TCanvas; var Rect: TRect; Flags: Longint);
var
  Text: string;
begin
  Text := GetLabelText;
  if (Flags and DT_CALCRECT <> 0) and ((Text = '') or ShowAccelChar and
    (Text[1] = '&') and (Text[2] = #0)) then Text := Text + ' ';
  if not ShowAccelChar then Flags := Flags or DT_NOPREFIX;
  Flags := DrawTextBiDiModeFlags(Flags);
  DrawText(Cnvs.Handle, PChar(Text), Length(Text), Rect, Flags);
end;

procedure TspSkinShadowLabel.Paint;
const
  Alignments: array[TAlignment] of Word = (DT_LEFT, DT_RIGHT, DT_CENTER);
  WordWraps: array[Boolean] of Word = (0, DT_WORDBREAK);
var
  MaskBuffer: TBitMap;
  FXMaskBuffer: TspEffectBmp;
  TX, TY: Integer;
  ParentImage: TBitMap;
  FXBuffer: TspEffectBmp;
  C: TColor;
  R: TRect;
  CR: TRect;
  DrawStyle: Longint;
begin
  if (Width < 1) or (Height < 1) then Exit;
  //
  Canvas.Font.Assign(Self.Font);
  // create mask
  MaskBuffer := TBitMap.Create;
  MaskBuffer.Width := Width;
  MaskBuffer.Height := Height;
  // draw shadow in mask
  with MaskBuffer.Canvas do
  begin
    //
    Brush.Color := clWhite;
    FillRect(Rect(0, 0, Width, Height));
    Font.Assign(Self.Font);
    Font.Color := clBlack;
    //
    Brush.Style := bsClear;
    R := ClientRect;
    R.Right := R.Right - 3;
    R.Bottom := R.Bottom - 3;
    DrawStyle := DT_EXPANDTABS or WordWraps[FWordWrap] or Alignments[FAlignment];
    if FLayout <> tlTop then
    begin
      CR := ClientRect;
      DoDrawText(MaskBuffer.Canvas, CR, DrawStyle or DT_CALCRECT);
      if FLayout = tlBottom then OffsetRect(R, 0, Height - CR.Bottom - 2)
      else OffsetRect(R, 0, (Height - CR.Bottom) div 2 - 2);
    end;
    OffsetRect(R, 1, 1);
    DoDrawText(MaskBuffer.Canvas, R, DrawStyle);
    OffsetRect(R, 1, 1);
    DoDrawText(MaskBuffer.Canvas, R, DrawStyle);
  end;
  FXMaskBuffer := TspEffectBmp.CreateFromhWnd(MaskBuffer.Handle);
  MaskBuffer.Free;
  // create parent image
  ParentImage := TBitMap.Create;
  ParentImage.Width := Width;
  ParentImage.Height := Height;
  GetParentImage(Self, ParentImage.Canvas);
  FXBuffer := TspEffectBmp.CreateFromhWnd(ParentImage.Handle);
  FXBuffer.MaskFillColor(FXMaskBuffer, clBlack, 0.3);
  FXBuffer.MaskAntialiasing(FXMaskBuffer, 1);
  FXBuffer.Draw(ParentImage.Canvas.Handle, 0, 0);
  // draw text
  GetSkinData;
  if FUseSkinColor and (SkinData <> nil) and (not SkinData.Empty) and (FIndex <> -1)
  then
    begin
      if TspDataSkinControl(FSD.CtrlList.Items[FIndex]) is TspDataSkinStdLabelControl
      then
        C := TspDataSkinStdLabelControl(FSD.CtrlList.Items[FIndex]).FontColor
      else
        C := Font.Color;
     end
  else
    C := Font.Color;
  //
  with ParentImage.Canvas do
  begin
    Font.Assign(Self.Font);
    Font.Color := C;
    Brush.Style := bsClear;
    R := ClientRect;
    R.Right := R.Right - 3;
    R.Bottom := R.Bottom - 3;
    DrawStyle := DT_EXPANDTABS or WordWraps[FWordWrap] or Alignments[FAlignment];
    if FLayout <> tlTop then
    begin
      CR := ClientRect;
      DoDrawText(ParentImage.Canvas, CR, DrawStyle or DT_CALCRECT);
      if FLayout = tlBottom then OffsetRect(R, 0, Height - CR.Bottom - 2)
      else OffsetRect(R, 0, (Height - CR.Bottom) div 2 - 2);
    end;
    DoDrawText(ParentImage.Canvas, R, DrawStyle);
  end;
  Canvas.Draw(0, 0, ParentImage);
  FXBuffer.Free;
  FXMaskBuffer.Free;
  ParentImage.Free;
end;

procedure TspSkinShadowLabel.Loaded;
begin
  inherited Loaded;
  AdjustBounds;
end;

procedure TspSkinShadowLabel.AdjustBounds;
const
  WordWraps: array[Boolean] of Word = (0, DT_WORDBREAK);
var
  DC: HDC;
  X: Integer;
  Rect: TRect;
  AAlignment: TAlignment;
begin
  if not (csReading in ComponentState) and FAutoSize then
  begin
    Canvas.Font := Self.Font;
    Rect := ClientRect;
    DC := GetDC(0);
    Canvas.Handle := DC;
    DoDrawText(Canvas, Rect, (DT_EXPANDTABS or DT_CALCRECT) or WordWraps[FWordWrap]);
    Canvas.Handle := 0;
    ReleaseDC(0, DC);
    X := Left;
    AAlignment := FAlignment;
    if UseRightToLeftAlignment then ChangeBiDiModeAlignment(AAlignment);
    if AAlignment = taRightJustify then Inc(X, Width - Rect.Right);
    Rect.Right := Rect.Right + 3;
    Rect.Bottom := Rect.Bottom + 3;
    SetBounds(X, Top, Rect.Right, Rect.Bottom);
  end;
end;

procedure TspSkinShadowLabel.SetAlignment(Value: TAlignment);
begin
  if FAlignment <> Value then
  begin
    FAlignment := Value;
    Invalidate;
  end;
end;

procedure TspSkinShadowLabel.SetAutoSize(Value: Boolean);
begin
  if FAutoSize <> Value then
  begin
    FAutoSize := Value;
    AdjustBounds;
  end;
end;

procedure TspSkinShadowLabel.SetFocusControl(Value: TWinControl);
begin
  FFocusControl := Value;
  if Value <> nil then Value.FreeNotification(Self);
end;

procedure TspSkinShadowLabel.SetShowAccelChar(Value: Boolean);
begin
  if FShowAccelChar <> Value then
  begin
    FShowAccelChar := Value;
    Invalidate;
  end;
end;

procedure TspSkinShadowLabel.SetLayout(Value: TTextLayout);
begin
  if FLayout <> Value then
  begin
    FLayout := Value;
    Invalidate;
  end;
end;

procedure TspSkinShadowLabel.SetWordWrap(Value: Boolean);
begin
  if FWordWrap <> Value then
  begin
    FWordWrap := Value;
    AdjustBounds;
    Invalidate;
  end;
end;

procedure TspSkinShadowLabel.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (AComponent = FFocusControl) then
    FFocusControl := nil;
end;

procedure TspSkinShadowLabel.CMTextChanged(var Message: TMessage);
begin
  Invalidate;
  AdjustBounds;
end;

procedure TspSkinShadowLabel.CMFontChanged(var Message: TMessage);
begin
  inherited;
  AdjustBounds;
end;

procedure TspSkinShadowLabel.CMDialogChar(var Message: TCMDialogChar);
begin
  if (FFocusControl <> nil) and Enabled and ShowAccelChar and
    IsAccel(Message.CharCode, Caption) then
    with FFocusControl do
      if CanFocus then
      begin
        SetFocus;
        Message.Result := 1;
      end;
end;

constructor TspFrameSkinControl.Create(AOwner: TComponent);
begin
  inherited;
  FFrame := 1;
  FrameW := 0;
  FrameH := 0;
  Picture := nil;
  MaskPicture := nil;
  FDefaultImage := TBitMap.Create;
  FDefaultMask := TBitMap.Create;
  FDefaultFramesCount := 1;
end;

destructor TspFrameSkinControl.Destroy;
begin
  FDefaultImage.Free;
  FDefaultMask.Free;
  if FRgn <> 0
  then
    begin
      DeleteObject(FRgn);
      FRgn := 0;
    end;
  inherited;
end;

procedure TspFrameSkinControl.WMEraseBkgnd;
begin
  if not FromWMPaint
  then
    PaintWindow(Msg.DC);
end;

procedure TspFrameSkinControl.Loaded;
begin
  inherited;
  CalcDefaultFrameSize;
  if (FIndex = -1) and (FSD = nil)
  then
    SetControlRegion;
end;

procedure TspFrameSkinControl.CalcDefaultFrameSize;
begin
  if FDefaultImage.Empty then Exit;
  FramesCount := FDefaultFramesCount;
  FramesPlacement := FDefaultFramesPlacement;
  case FramesPlacement of
   fpHorizontal:
     begin
       FrameW := FDefaultImage.Width div FramesCount;
       FrameH := FDefaultImage.Height;
     end;
   fpVertical:
     begin
       FrameW := FDefaultImage.Width;
       FrameH := FDefaultImage.Height div FramesCount;
     end;
  end;
end;

procedure TspFrameSkinControl.SetDefaultMask;
begin
  FDefaultMask.Assign(Value);
  SetControlRegion;
  RePaint;
end;

procedure TspFrameSkinControl.SetDefaultImage;
begin
  FDefaultImage.Assign(Value);
  FFrame := 1;
  CalcDefaultFrameSize;
  if not FDefaultImage.Empty
  then
    SetBounds(Left, Top, FrameW, FrameH);
  RePaint;
end;

procedure TspFrameSkinControl.SetDefaultFramesCount;
begin
  if Value <= 0
  then
    FDefaultFramesCount := 1
  else
    FDefaultFramesCount := Value;
  CalcDefaultFrameSize;
  if not FDefaultImage.Empty
  then
    SetBounds(Left, Top, FrameW, FrameH);
  RePaint;
end;

procedure TspFrameSkinControl.SetDefaultFramesPlacement;
begin
  FDefaultFramesPlacement := Value;
  CalcDefaultFrameSize;
  if not FDefaultImage.Empty
  then
    SetBounds(Left, Top, FrameW, FrameH);
  RePaint;
end;

procedure TspFrameSkinControl.GetSkinData;
begin
  inherited;
  if FIndex <> -1
  then
    if TspDataSkinControl(FSD.CtrlList.Items[FIndex]) is TspDataSkinFrameControl
    then
      begin