be_controls.pas

KSDev.BlockEngine.v3.03.rar 界面控件

procedure TbeStrokeWidthBox.DoChangeFocus(Sender: TObject);
begin
  inherited;
  if (FEditor <> nil) and (FEditor.FocusedBlock <> nil) then
  begin
    StrokeWidth := ConvertValue(FEditor.UnitType, FEditor.FocusedBlock.Stroke.Width, Pt);
  end;
end;

{ TbeStrokeCapBox ==============================================================}

constructor TbeStrokeCapBox.Create(AOwner: TComponent);
begin
  inherited;
end;

destructor TbeStrokeCapBox.Destroy;
begin
  inherited;

end;

procedure TbeStrokeCapBox.RebuildList;
begin
  inherited;
  Items.Add('Flat');
  Items.Add('Round');
  Items.Add('Square');
  Items.Add('Triangle');
end;

procedure TbeStrokeCapBox.DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState);
var
  G: TGPGraphics;
  P: TGPPen;
begin
  with Canvas do
  begin
    if odFocused in State then
    begin
      Brush.Color := clHighlight;
      FillRect(Rect);
      Brush.Color := clWhite;
    end
    else
    begin
      Brush.Color := Color;
      FillRect(Rect);
      Brush.Color := clBlack;
    end;
  end;

  G := TGPGraphics.Create(Canvas.Handle, 0, 0);
  try
    if odFocused in State then
      P := TGPPen.Create(aclWhite, 9)
    else
      P := TGPPen.Create(aclBlack, 9);

    P.SetLineJoin(LineJoinRound);
    case Index of
      0: P.SetLineCap(0, 0, 0);
      1: P.SetLineCap(2, 2, 2);
      2: P.SetLineCap(1, 1, 1);
      3: P.SetLineCap(3, 3, 3);
    end;

    G.DrawLine(P, Rect.Left + 5, (Rect.Top + Rect.Bottom) div 2, Rect.Right - 5, (Rect.Top + Rect.Bottom) div 2);

    P.SetLineCap(0, 0, 0);
    P.SetWidth(1);
    P.SetColor(aclYellow);
    G.DrawLine(P, Rect.Left + 5, (Rect.Top + Rect.Bottom) div 2, Rect.Right - 5, (Rect.Top + Rect.Bottom) div 2);

    P.Free;
  finally
    G.Free;
  end;
end;

function TbeStrokeCapBox.GetLineCap: LineCapType;
begin
  if ItemIndex >= 0 then
    Result := LineCapType(ItemIndex)
  else
    Result := CapFlat;
end;

procedure TbeStrokeCapBox.SetLineCap(const Value: LineCapType);
begin
  ItemIndex := Integer(Value);
end;

procedure TbeStrokeCapBox.Change;
begin
  inherited;
  if (FEditor <> nil) and (FEditor.FocusedBlock <> nil) then
  begin
    FEditor.FocusedBlock.Stroke.Cap := Cap;
    FEditor.FocusedBlock.Repaint;
  end;
end;

procedure TbeStrokeCapBox.DoChangeFocus(Sender: TObject);
begin
  inherited;
  if (FEditor <> nil) and (FEditor.FocusedBlock <> nil) then
  begin
    Cap := FEditor.FocusedBlock.Stroke.Cap;
  end;
end;

{ TbeStrokePatternBox =========================================================}

constructor TbeStrokePatternBox.Create(AOwner: TComponent);
begin
  inherited;
end;

destructor TbeStrokePatternBox.Destroy;
begin
  inherited;
end;

procedure TbeStrokePatternBox.Change;
begin
  inherited;
  if (FEditor <> nil) and (FEditor.FocusedBlock <> nil) then
  begin
    FEditor.FocusedBlock.Stroke.Pattern := Pattern;
    FEditor.FocusedBlock.Repaint;
  end;
end;

procedure TbeStrokePatternBox.DoChangeFocus(Sender: TObject);
begin
  inherited;
  if (FEditor <> nil) and (FEditor.FocusedBlock <> nil) then
  begin
    Pattern := FEditor.FocusedBlock.Stroke.Pattern;
  end;
end;

procedure TbeStrokePatternBox.RebuildList;
begin
  inherited;
  Items.Add('Solid');
  Items.Add('Dash');
  Items.Add('Dot');
  Items.Add('DashDot');
  Items.Add('DashDotDot');
end;

procedure TbeStrokePatternBox.DrawItem(Index: Integer; Rect: TRect;
  State: TOwnerDrawState);
var
  G: TGPGraphics;
  P: TGPPen;
begin
  with Canvas do
  begin
    if odFocused in State then
    begin
      Brush.Color := clHighlight;
      FillRect(Rect);
      Brush.Color := clWhite;
    end
    else
    begin
      Brush.Color := Color;
      FillRect(Rect);
      Brush.Color := clBlack;
    end;
  end;

  G := TGPGraphics.Create(Canvas.Handle, 0, 0);
  try
    if odFocused in State then
      P := TGPPen.Create(aclWhite, 3)
    else
      P := TGPPen.Create(aclBlack, 3);
    P.SetDashStyle(DashStyle(Index));

    G.DrawLine(P, Rect.Left, (Rect.Top + Rect.Bottom) div 2, Rect.Right, (Rect.Top + Rect.Bottom) div 2);

    P.Free;
  finally
    G.Free;
  end;
end;

function TbeStrokePatternBox.GetPattern: LinePatternType;
begin
  if ItemIndex >= 0 then
    Result := LinePatternType(ItemIndex)
  else
    Result := LinePaternSolid;
end;

procedure TbeStrokePatternBox.SetPattern(const Value: LinePatternType);
begin
  ItemIndex := Integer(Value);
end;

{ TbeStrokeColorBox =========================================================}

constructor TbeStrokeColorBox.Create(AOwner: TComponent);
begin
  inherited;
end;

destructor TbeStrokeColorBox.Destroy;
begin
  inherited;
end;

procedure TbeStrokeColorBox.Change;
begin
  inherited;
  if (FEditor <> nil) and (FEditor.FocusedBlock <> nil) then
  begin
    FEditor.FocusedBlock.Stroke.Color := ColorValue;
    FEditor.FocusedBlock.Repaint;
  end;
end;

procedure TbeStrokeColorBox.DoChangeFocus(Sender: TObject);
begin
  inherited;
  if (FEditor <> nil) and (FEditor.FocusedBlock <> nil) then
  begin
    ColorValue := FEditor.FocusedBlock.Stroke.Color;
  end;
end;

procedure TbeStrokeColorBox.RebuildList;
const
  ColorCount = 7;
  HueCount   = 10;
var
  r, g, b: integer;
  h, l: integer;
  C: TColor;
begin
  inherited;
  Items.Clear;
  { Gray }
  for r := 0 to ColorCount do
    Items.Add(IntToStr(RGB(Round((r / ColorCount) * $FF), Round((r / ColorCount) * $FF), Round((r / ColorCount) * $FF))));

  { HSL ----}
  for h := 0 to HueCount do // hue
    for l := 0 to ColorCount do // lum
    begin
      Items.Add(IntToStr(HSLtoRGB(h / (HueCount + 1), 0.5, (l + 1) / (ColorCount + 2))));
    end;
end;

procedure TbeStrokeColorBox.DrawItem(Index: Integer; Rect: TRect;
  State: TOwnerDrawState);
var
  G: TGPGraphics;
  P: TGPPen;
begin
  with Canvas do
  begin
    if odFocused in State then
    begin
      Brush.Color := clHighlight;
      FillRect(Rect);
      Brush.Color := clWhite;
    end
    else
    begin
      Brush.Color := Color;
      FillRect(Rect);
      Brush.Color := clBlack;
    end;

    Brush.Color := StringToColor(Items[Index]);
    InflateRect(Rect, -2, -2);
    FillRect(Rect);

    if odFocused in State then
      DrawRect(Canvas, Rect, clHighlightText)
    else
      DrawRect(Canvas, Rect, clWindowText)
  end;
end;

function TbeStrokeColorBox.GetColor: ColorType;
begin
  if ItemIndex >= 0 then
    Result := $FF000000 or FromRGB(ColorToRGB(StringToColor(Items[ItemIndex])))
  else
    Result := $FF000000;
end;

function TbeStrokeColorBox.GetRandomColor: ColorType;
begin
  Result := $FF000000 or FromRGB(ColorToRGB(StringToColor(Items[random(16)])))
end;

procedure TbeStrokeColorBox.SetColor(const Value: ColorType);
begin
  ItemIndex := Items.IndexOf(ColorToString(ToRGB(Value) and not $FF000000));
end;

{ TbeStrokeAlphaBox =========================================================}

constructor TbeStrokeAlphaBox.Create(AOwner: TComponent);
begin
  inherited;
end;

destructor TbeStrokeAlphaBox.Destroy;
begin
  inherited;
end;

procedure TbeStrokeAlphaBox.Change;
begin
  inherited;
  if (FEditor <> nil) and (FEditor.FocusedBlock <> nil) then
  begin
    FEditor.FocusedBlock.Stroke.Color := (FEditor.FocusedBlock.Stroke.Color and not $FF000000) or (Alpha shl 24);
    FEditor.FocusedBlock.Repaint;
  end;
end;

procedure TbeStrokeAlphaBox.RebuildList;
begin
  inherited;
  Items.Add('100');
  Items.Add('90');
  Items.Add('80');
  Items.Add('70');
  Items.Add('60');
  Items.Add('50');
  Items.Add('40');
  Items.Add('30');
  Items.Add('20');
  Items.Add('10');
  Items.Add('0');
end;

procedure TbeStrokeAlphaBox.DrawItem(Index: Integer; Rect: TRect;
  State: TOwnerDrawState);
var
  G: TGPGraphics;
  P: TGPPen;
  B: TGPBrush;
  R: TRect;
begin
  with Canvas do
  begin
    if odFocused in State then
    begin
      Brush.Color := clHighlight;
      FillRect(Rect);
      Brush.Color := clWhite;
    end
    else
    begin
      Brush.Color := Color;
      FillRect(Rect);
      Brush.Color := clBlack;
    end;

    { Draw stroke alhpa selection }
    G := TGPGraphics.Create(Canvas.Handle, 0, 0);
    try
      G.SetPageUnit(UnitPixel);
      P := TGPPen.Create(aclBlack, 1);
      B := TGPSolidBrush.Create($0 or (Round((StrToInt(Items[Index]) / 100) * $FF) shl 24));

      R := Rect;
      InflateRect(R, -2, -2);
      R.Right := R.Left + 30;
      with R do
      begin
        G.FillRectangle(B, Left, Top, Right - Left, Bottom - Top);
        G.DrawRectangle(P, Left, Top, Right - Left, Bottom - Top);
      end;
      P.Free;
      
      if (odSelected in State) or (odFocused in State) then
        Canvas.Font.Color := clHighlightText
      else
        Canvas.Font.Color := clWindowText;
      InflateRect(Rect, -4, -2);
      Rect.Left := 40;
      DrawText(Canvas, Items[Index] + '%', Rect, DT_SINGLELINE or DT_VCENTER);
    finally
      G.Free;
    end;
  end;
end;

function TbeStrokeAlphaBox.GetAlpha: byte;
begin
  if ItemIndex >= 0 then
    Result := Round((StrToInt(Items[ItemIndex]) / 100) * $FF)
  else
    Result := $FF;
end;

procedure TbeStrokeAlphaBox.SetAlpha(const Value: byte);
begin
  ItemIndex := Round((($FF - Value) / $FF) * 10);
end;

{ Fill styles =================================================================}

{ TbeFillColorBox =========================================================}

constructor TbeFillColorBox.Create(AOwner: TComponent);
begin
  inherited;
end;

destructor TbeFillColorBox.Destroy;
begin
  inherited;