⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 flatskins.pas

📁 comerose_flatstyle_v4.42.9.0_d7.rar
💻 PAS
📖 第 1 页 / 共 2 页
字号:
  FBackUseBitmap   := false;
  FTitleUseBitmap  := false;

  FUserFace        := DefaultStyleFace;
  FTransparent     := tmNone;
  FBarsHeight      := DefaultBarsHeight;
  FItemHeight      := DefaultItemHeight;
  FTitleHeight     := DefaultTitleHeight;
  FTitleHas        := true;
  FScrollBars      := True;
  FParentFont      := True;
end;

destructor TFlatSkin.Destroy;
begin
  FTitleFont.Free;
  FTitleBitmap.Free;
  FBarTopBitmap.Free;
  FBarDownBitmap.Free;
  FBackBitmap.Free;
  inherited Destroy;
end;

procedure TFlatSkin.SetBitmaps(const Index: Integer; const Value: TBitmap);
begin
  case index of
   0:FBarTopBitmap.Assign(Value);
   1:FBarDownBitmap.Assign(Value);
   2:FBackBitmap.Assign(Value);
   3:FTitleBitmap.Assign(Value);
  end;
  Changed;
end;

procedure TFlatSkin.SetColors(const Index: Integer; const Value: TColor);
begin
  case index of
    0:FBarStopColor     := Value;
    1:FBarStartColor    := Value;
    2:FBackStopColor    := Value;
    3:FBackStartColor   := Value;
    4:FItemStopColor    := Value;
    5:FItemStartColor   := Value;
    6:FItemRectColor    := Value;
    7:FItemSelectColor  := Value;
    8:FBorderColor      := Value;
    9:FBarColor         := Value;
   10:FBarArrowColor    := Value;
   11:FItemFrameColor   := Value;
   12:FBackdropColor    := Value;
   13:FTitleStartColor  := Value;
   14:FTitleStopColor   := Value;
   15:FTitleColor       := Value;
   16:FItemLineColor    := Value;
   17:FBackFocusColor   := Value;
  end;
  Changed;
end;

procedure TFlatSkin.SetHeights(Index, Value: integer);
begin
  case index of
    0:begin
      if Value < 12 then
         Value := 12;
      FBarsHeight  := value;
      end;
    1:begin
      if Value < 17 then
         Value := 17;
      FItemHeight  := value;
      end;
    2:begin
      if Value < 18 then
         value := 18;
      FTitleHeight := Value;
      end;
  end;
  Changed;
end;

procedure TFlatSkin.SetOriens(const Index: Integer; const Value: TStyleOrien);
begin
  case index of
    0:FBarOrien      := Value;
    1:FBackdropOrien := Value;
    2:FItemOrien     := Value;
    3:FTitleOrien    := Value;
  end;
  Changed;
end;

procedure TFlatSkin.SetScrollBars(const Value: Boolean);
begin
  if FScrollBars <> value then begin
     FScrollBars := Value;
     Changed;
  end;
end;

procedure TFlatSkin.SetTitleAlignment(const Value: TAlignmentText);
begin
  if FTitleAlignment <> value then begin
     FTitleAlignment := Value;
     Changed;
  end;
end;

procedure TFlatSkin.SetTitleFont(const Value: TFont);
begin
  if FTitleFont <> Value then
  begin
     FTitleFont.Assign(Value);
     FParentFont := false;
  end;
end;

procedure TFlatSkin.SetTitleHas(const Value: boolean);
begin
  if FTitleHas <> value then begin
     FTitleHas := Value;
     Changed;
  end;
end;

procedure TFlatSkin.SetTitlePosition(const Value: TTitlePosition);
begin
  if FTitlePosition <> Value then begin
     FTitlePosition := Value;
     Changed;
  end;
end;

procedure TFlatSkin.SetTransparent(const Value: TTransparentMode);
begin
  if FTransparent <> Value then begin
     FTransparent := Value;
     Changed;
  end;
end;

procedure TFlatSkin.SetUseBitmap(const Index: Integer; const Value: boolean);
begin
  case index of
   0:FBarUseBitmap   := Value;
   1:FBackUseBitmap  := Value;
   2:FTitleUseBitmap := Value;
   3:FItemLineHas    := Value;
  end;
  Changed;
end;

procedure TFlatSkin.SetUserFace(const Value: TStyleFace);
begin
  if FUserFace <> Value then begin
     FUserFace := Value;
     Changed;
  end;
end;

procedure TFlatSkin.SetParentFont(const Value: boolean);
begin
  if FParentFont <> Value then begin
     FParentFont := Value;
     if (FParentFont)and(FParent<>nil) then begin
         FTitleFont.Assign(TVersionControl(Parent).Font);
     end;
     Changed;
  end;
end;

function TFlatSkin.GetParent: TControl;
begin
  Result := FParent;
end;

{ TCheckStyle }

procedure TCheckStyle.Assign(Source: TPersistent);
begin
  if Source is TCheckStyle then
  begin
     FSelectColor         := TCheckStyle(Source).SelectColor;
     FSelectBackdropColor := TCheckStyle(Source).SelectBackdropColor;
     FSelectBorderColor   := TCheckStyle(Source).SelectBorderColor;
     FSelectPosition      := TCheckStyle(Source).SelectPosition;
     FSelectSize          := TCheckStyle(Source).SelectSize;
     FSelectCheckColor    := TCheckStyle(Source).SelectCheckColor;
     FSelectStartColor    := TCheckStyle(Source).SelectStartColor;
     FSelectStopColor     := TCheckStyle(Source).SelectStopColor;
     FSelectOrien         := TCheckStyle(Source).SelectOrien;
     Changed;
     Exit;
  end;
  inherited Assign(Source);
end;

constructor TCheckStyle.Create;
begin
  inherited Create;
  FSelectColor         := DefaultCheckSelectColor;
  FSelectBackdropColor := DefaultCheckBackColor;
  FSelectBorderColor   := DefaultCheckBorderColor;
  FSelectStartColor    := DefaultSelectStartColor;
  FSelectStopColor     := DefaultSelectStopColor;
  FSelectOrien         := bsVertical;
  FSelectSize          := 12;
  FSelectCheckColor    := DefaultFlatColor;
end;

procedure TCheckStyle.SetColors(const Index: Integer; const Value: TColor);
begin
  case index of
   0:FSelectColor         := Value;
   1:FSelectBackdropColor := Value;
   2:FSelectBorderColor   := Value;
   3:FSelectStartColor    := Value;
   4:FSelectStopColor     := Value;
   5:FSelectCheckColor    := Value;
  end;
  Changed;
end;

procedure TCheckStyle.SetSelectPosition(const Value: TCheckPosition);
begin
  if FSelectPosition <> value then begin
     FSelectPosition := Value;
     Changed;
  end;
end;

procedure TCheckStyle.SetSelectOrien(const Value: TStyleOrien);
begin
  if FSelectOrien <> value then begin
     FSelectOrien := Value;
     Changed;
  end;
end;

procedure TCheckStyle.SetSelectSize(Value: Integer);
begin
  if FSelectSize <> value then begin
     if Value  < 12 then
        Value := 12;
     FSelectSize := Value;
     Changed;
  end;
end;

{ TListStyle }

procedure TListStyle.Assign(Source: TPersistent);
begin
  if Source is TListStyle then
  begin
     FItemAlignment := TListStyle(Source).ItemAlignment;
     Changed;
     exit;
  end;
  inherited Assign(Source);
end;

constructor TListStyle.Create;
begin
  inherited Create;
  FItemAlignment := stLeft;
end;

procedure TListStyle.SetItemAlignment(const Value: TAlignmentText);
begin
  if FItemAlignment <> Value then begin
     FItemAlignment := Value;
     Changed;
  end;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -