be_controls.pas

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

{==============================================================================

  BlockEngine Controls
  Copyright (C) 2000-2006 by Eugene Kryukov
  All rights reserved

  All conTeThements of this file and all other files included in this archive
  are Copyright (C) 2006 Eugene Kryukov. Use and/or distribution of
  them requires acceptance of the License Agreement.

  See License.txt for licence information

  $Id: be_controls.pas,v 1.1.1.1 2006/11/02 17:02:51 eugene Exp $

===============================================================================}

unit be_controls;

{$I be_define.inc}
{$T-,W-,X+,P+}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Buttons,
  ExtCtrls, StdCtrls, Dialogs, gdipapi, gdipobj, ddoc, deditor, be_bitmap;

type

{ ComboBoxes }

  TbeCustomBox = class(TComboBox)
  private
    FEditor: TBlockEditor;
    procedure SetEditor(const Value: TBlockEditor);
  protected
    procedure CreateWnd; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure DoChangeFocus(Sender: TObject); dynamic;
    procedure RebuildList; dynamic;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Editor: TBlockEditor read FEditor write SetEditor;
    property Items stored false;
  end;

  TbeStrokeWidthBox = class(TbeCustomBox)
  private
    function GetPenWidth: single;
    procedure SetStrokeWidth(const Value: single);
    function GetRandomWidth: single;
  protected
    procedure RebuildList; override;
    procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override;
    procedure Change; override;
    procedure DoChangeFocus(Sender: TObject); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
    property StrokeWidth: single read GetPenWidth write SetStrokeWidth;
    property RandomWidth: single read GetRandomWidth; 
  published
    property Items stored false;
  end;

  TbeStrokeCapBox = class(TbeCustomBox)
  private
    function GetLineCap: LineCapType;
    procedure SetLineCap(const Value: LineCapType);
  protected
    procedure RebuildList; override;
    procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override;
    procedure Change; override;
    procedure DoChangeFocus(Sender: TObject); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
    property Cap: LineCapType read GetLineCap write SetLineCap;
  published
  end;

  TbeStrokePatternBox = class(TbeCustomBox)
  private
    function GetPattern: LinePatternType;
    procedure SetPattern(const Value: LinePatternType);
  protected
    procedure RebuildList; override;
    procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override;
    procedure Change; override;
    procedure DoChangeFocus(Sender: TObject); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
    property Pattern: LinePatternType read GetPattern write SetPattern;
  published
  end;

  TbeStrokeColorBox = class(TbeCustomBox)
  private
    function GetColor: ColorType;
    procedure SetColor(const Value: ColorType);
    function GetRandomColor: ColorType;
  protected
    procedure RebuildList; override;
    procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override;
    procedure Change; override;
    procedure DoChangeFocus(Sender: TObject); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
    property ColorValue: ColorType read GetColor write SetColor;
    property RandomValue: ColorType read GetRandomColor;
  published
  end;

  TbeStrokeAlphaBox = class(TbeCustomBox)
  private
    function GetAlpha: byte;
    procedure SetAlpha(const Value: byte);
  protected
    procedure RebuildList; override;
    procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override;
    procedure Change; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
    property Alpha: byte read GetAlpha write SetAlpha;
  published
  end;

{ Fill }

  TbeFillColorBox = class(TbeCustomBox)
  private
    function GetColor: ColorType;
    procedure SetColor(const Value: ColorType);
    function GetRandomColor: ColorType;
  protected
    procedure RebuildList; override;
    procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override;
    procedure Change; override;
    procedure DoChangeFocus(Sender: TObject); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
    property ColorValue: ColorType read GetColor write SetColor;
    property RandomValue: ColorType read GetRandomColor;
  published
  end;

  TbeFillAlphaBox = class(TbeCustomBox)
  private
    function GetAlpha: byte;
    procedure SetAlpha(const Value: byte);
  protected
    procedure RebuildList; override;
    procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override;
    procedure Change; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
    property Alpha: byte read GetAlpha write SetAlpha;
  published
  end;

  TbeFillStyleBox = class(TbeCustomBox)
  private
    function GetPattern: FillPatternType;
    function GetStyle: FillStyleType;
    function GetGradientAngle: single;
    procedure SetPattern(const Value: FillPatternType);
    procedure SetGradientAngle(const Value: single);
    procedure SetStyle(const Value: FillStyleType);
  protected
    procedure RebuildList; override;
    procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override;
    procedure Change; override;
    procedure DoChangeFocus(Sender: TObject); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
    property Pattern: FillPatternType read GetPattern write SetPattern;
    property Style: FillStyleType read GetStyle write SetStyle;
    property GradientAngle: single read GetGradientAngle write SetGradientAngle;
  published
  end;

implementation {===============================================================}

uses math, be_utils;

type

  TColorRec = packed record
    case longword of
      0: (Color: TColor);
      2: (HiWord, LoWord: Word);
      3: (R, G, B, A: Byte);
    end;

function GetCorrectValue(S: string): string;
var
  C: string;
  i: integer;
begin
  C := S;
  for i := 1 to Length(C) do
    if C[i] = '.' then
      C[i] := DecimalSeparator;
  Result := C;
end;

function RGB(R, G, B: byte): TColor;
begin
  TColorRec(Result).r := R;
  TColorRec(Result).g := G;
  TColorRec(Result).b := B;
  TColorRec(Result).a := 0;
end;

function HSLtoRGB(H, S, L: Single): TColor;
var
  M1, M2: Single;
  R, G, B: Byte;

  function HueToColor(Hue: Single): Byte;
  var
    V: Double;
  begin
    Hue := Hue - Floor(Hue);

    if 6 * Hue < 1 then V := M1 + (M2 - M1) * Hue * 6
    else if 2 * Hue < 1 then V := M2
    else if 3 * Hue < 2 then V := M1 + (M2 - M1) * (2 / 3 - Hue) * 6
    else V := M1;
    Result := Round(255 * V);
  end;
begin
  if S = 0 then
  begin
    R := Round(255 * L);
    G := R;
    B := R;
  end
  else
  begin
    if L <= 0.5 then M2 := L * (1 + S)
    else M2 := L + S - L * S;
    M1 := 2 * L - M2;
    R := HueToColor(H + 1 / 3);
    G := HueToColor(H);
    B := HueToColor(H - 1 / 3)
  end;
  Result := RGB(R, G, B);
end;

{ TbeCustomBox ================================================================}

constructor TbeCustomBox.Create(AOwner: TComponent);
begin
  inherited;
  Style := csOwnerDrawFixed;
end;

destructor TbeCustomBox.Destroy;
begin
  if Editor <> nil then
    Editor.RemoveChangeFocusBlockNotify(DoChangeFocus);
  inherited;
end;

procedure TbeCustomBox.CreateWnd;
begin
  inherited;
  RebuildList;
end;

procedure TbeCustomBox.DoChangeFocus(Sender: TObject);
begin

end;

procedure TbeCustomBox.RebuildList;
begin

end;

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

procedure TbeCustomBox.SetEditor(const Value: TBlockEditor);
begin
  if FEditor <> Value then
  begin
    if FEditor <> nil then
      FEditor.RemoveChangeFocusBlockNotify(DoChangeFocus);

    FEditor := Value;

    if FEditor <> nil then
      FEditor.AddChangeFocusBlockNotify(DoChangeFocus);
  end;
end;

{ TbeStrokeWidthBox ==============================================================}

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

procedure TbeStrokeWidthBox.RebuildList;
begin
  inherited;
  Items.BeginUpdate;
  Items.Clear;
  Items.Add('0.25');
  Items.Add('0.50');
  Items.Add('0.75');
  Items.Add('1.00');
  Items.Add('1.25');
  Items.Add('1.50');
  Items.Add('1.75');
  Items.Add('2.00');
  Items.Add('2.50');
  Items.Add('3.00');
  Items.Add('4.00');
  Items.Add('6.00');
  Items.EndUpdate;
end;

destructor TbeStrokeWidthBox.Destroy;
begin
  inherited;
end;

procedure TbeStrokeWidthBox.DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState);
var
  i: integer;
  C, S: string;
  W: single;
begin
  case Index of
    0: S := '1/4 pt';
    1: S := '1/2 pt';
    2: S := '3/4 pt';
    3: S := '1 pt';
    4: S := '1 1/4 pt';
    5: S := '1 1/2 pt';
    6: S := '1 3/4 pt';
    7: S := '2 pt';
    8: S := '2 1/2 pt';
    9: S := '3 pt';
    10: S := '4 pt';
    11: S := '6 pt';
  end;

  if (odSelected in State) or (odFocused in State) then
    FillRect(Canvas, Rect, clHighlight)
  else
    FillRect(Canvas, Rect, Color);

  if (odSelected in State) or (odFocused in State) then
    Canvas.Font.Color := clHighlightText
  else
    Canvas.Font.Color := clWindowText;

  InflateRect(Rect, -4, -2);
  DrawText(Canvas, S, Rect, DT_SINGLELINE or DT_VCENTER);

  C := Items[Index];
  for i := 1 to Length(C) do
    if C[i] = '.' then
      C[i] := DecimalSeparator;

  W := StrToFloat(GetCorrectValue(C));

  if (odSelected in State) or (odFocused in State) then
    FillRect(Canvas, Rect.Left + TextWidth(Canvas, '2 1/2 pt') + 10, Round(Rect.Top + RectHeight(Rect) div 2 - W),
       Rect.Right - 10, Round(Rect.Top + RectHeight(Rect) div 2 + W) + 1, clHighlightText)
  else
    FillRect(Canvas, Rect.Left + TextWidth(Canvas, '2 1/2 pt') + 10, Round(Rect.Top + RectHeight(Rect) div 2 - W),
       Rect.Right - 10, Round(Rect.Top + RectHeight(Rect) div 2 + W) + 1, clWindowText);
end;

function TbeStrokeWidthBox.GetPenWidth: single;
begin
  if ItemIndex >= 0 then
  begin
    Result := StrToFloat(GetCorrectValue(Items[ItemIndex]))
  end
  else
    Result := 0;
end;

function TbeStrokeWidthBox.GetRandomWidth: single;
begin
  Result := StrToFloat(GetCorrectValue(Items[Random(Items.Count)]))
end;

procedure TbeStrokeWidthBox.SetStrokeWidth(const Value: single);
begin
  ItemIndex := Items.IndexOf(Format('%4.2f', [Value]));
end;

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