sgradbuilder.pas

AlphaControls是一个Delphi标准控件的集合

unit sGradBuilder;
interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, Menus, sGradient, StdCtrls, Buttons, sStyleActive,
  sSkinProvider, sPanel, sCustomLabel, sButtonControl, sCustomButton;

type
  TGradPoint = class(TPanel)
  public
    constructor Create(AOwner: TComponent); override;
  end;

  TPointArray = array of TGradPoint;

  TGradBuilder = class(TForm)
    PopupMenu1: TPopupMenu;
    Changecolor1: TMenuItem;
    Delete1: TMenuItem;
    ColorDialog1: TColorDialog;
    sSkinProvider1: TsSkinProvider;
    PaintPanel: TPanel;
    PaintBox1: TPaintBox;
    Panel2: TsPanel;
    TemplatePanel: TPanel;
    Label1: TsLabel;
    ComboBox1: TComboBox;
    BitBtn1: TsButton;
    procedure Panel2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure TemplatePanelMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure TemplatePanelMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Changecolor1Click(Sender: TObject);
    procedure PopupMenu1Popup(Sender: TObject);
    procedure Delete1Click(Sender: TObject);
    procedure PaintBox1Paint(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure TemplatePanelMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure TemplatePanelDblClick(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    { Private declarations }
  public
    a : TPointArray;
    g : TsGradArray;
    LastPoint : TGradPoint;
    ModalResult : TModalResult;
    CurrentGradient : TsBGGradient;
    CurrentArray : TsGradArray;
    { Public declarations }
    function AsString : string;
    procedure LoadFromArray(NewArray : TsGradArray);
    procedure ReCalcData;
    procedure NewPoint(Owner : TsPanel; y : integer; Color : TColor);
    procedure DeleteFromArray(p : TGradPoint);
  end;

const
  PointHeight = 6;

var
  GradBuilder: TGradBuilder;
  NoMouse : boolean;


procedure CreateEditorForm;
procedure KillForm;

implementation

{$R *.DFM}

procedure CreateEditorForm;
begin
  Application.CreateForm(TGradBuilder, GradBuilder);
end;

procedure KillForm;
begin
  if Assigned(GradBuilder) then begin
    GradBuilder.Release;
  end;
end;

procedure TGradBuilder.ReCalcData;
var
  i, c : integer;
  CurPoint, PrevPoint : TGradPoint;
  function GetMinPoint(top : integer) : TGradPoint;
  var
    i : integer;
  begin
    Result := a[1];
    for i := 0 to c - 1 do begin
      if (a[i].Top > Top) and (a[i].Top <= Result.Top) then begin
        Result := a[i];
      end;
    end;
  end;
begin
  SetLength(g, 0);
  c := Length(a);
  PrevPoint := a[0];
  for i := 0 to c - 1 do begin
    CurPoint := GetMinPoint(PrevPoint.Top);

    SetLength(g, Length(g) + 1);

    g[Length(g) - 1].Color1 := ColorToRGB(PrevPoint.Color);
    g[Length(g) - 1].Color2 := ColorToRGB(CurPoint.Color);
    g[Length(g) - 1].Percent := (CurPoint.Top - PrevPoint.Top) div 2;
    if Assigned(CurrentGradient) and (Length(CurrentGradient.FGradArray) > 0) then
      g[Length(g) - 1].Mode1 := CurrentGradient.FGradArray[0].Mode1
    else if (CurrentArray <> nil) and (Length(CurrentArray) > 0) then begin
     g[Length(g) - 1].Mode1 := CurrentArray[0].Mode1;
    end
    else g[Length(g) - 1].Mode1 := ComboBox1.ItemIndex;

    PrevPoint := CurPoint;
  end;
  GradBuilder.PaintBox1.Repaint;
  if Assigned(CurrentGradient) then CurrentGradient.Data := AsString;
end;

procedure TGradBuilder.NewPoint(Owner : TsPanel; y : integer; Color : TColor);
var
  c : integer;
begin
  c := Length(a);
  a[c - 1] := TGradPoint.Create(Owner);
  a[c - 1].Left := 5;
  a[c - 1].Width := Owner.Width - 10;
  a[c - 1].Top := y;
  a[c - 1].Visible := True;
  a[c - 1].Caption := ' ';
  a[c - 1].Color := ColorToRGB(Color);
  a[c - 1].PopupMenu := GradBuilder.PopupMenu1;
  a[c - 1].onMouseDown := GradBuilder.TemplatePanel.OnMouseDown;
  a[c - 1].onMouseUp := GradBuilder.TemplatePanel.OnMouseUp;
  a[c - 1].onMouseMove := GradBuilder.TemplatePanel.OnMouseMove;
  a[c - 1].onDblClick := GradBuilder.TemplatePanel.OnDblClick;
  a[c - 1].Tag := Length(a) - 1;
end;

procedure TGradBuilder.DeleteFromArray(p : TGradPoint);
var
  i : integer;
begin
  for i := p.Tag to Length(a) - 2 do begin
    a[i] := a[i + 1];
  end;
  SetLength(a, Length(a) - 1);
  p.PopupMenu := nil;
  p.onMouseDown := nil;
  p.onMouseMove := nil;
  p.onMouseUp := nil;
  if Assigned(p) then FreeAndNil(p);
 
end;

{ TGradPoint }

constructor TGradPoint.Create(AOwner: TComponent);
begin
  inherited;
  Parent := TWinControl(AOwner);
  Visible := False;
  Height := PointHeight;
end;

{ TGradBuilder }

procedure TGradBuilder.Panel2Click(Sender: TObject);
var
  m : TMouse;
  p : TPoint;
begin
  m := TMouse.Create;
  p := m.CursorPos;
  p := Panel2.ScreenToClient(p);
  if Assigned(m) then FreeAndNil(m);

  SetLength(a, Length(a) + 1);
  NewPoint(Panel2, p.y, clWhite);
  ReCalcData;
end;

procedure TGradBuilder.FormCreate(Sender: TObject);
begin
  // FirstPoint
  SetLength(a, Length(a) + 1);
  NewPoint(Panel2, 0, clWhite);
  a[Length(a) - 1].Name := 'FirstPoint';

  //LastPoint
  SetLength(a, Length(a) + 1);
  NewPoint(Panel2, Panel2.Height - PointHeight, clBtnShadow);
  a[Length(a) - 1].Name := 'LastPoint';
end;

procedure TGradBuilder.TemplatePanelMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  t : integer;
begin
  if not NoMouse then begin
    LastPoint := TGradPoint(Sender);
    if (Button = mbLeft) and (LastPoint.Name <> 'FirstPoint') and (LastPoint.Name <> 'LastPoint') then begin
      t := LastPoint.Top;
      ReleaseCapture;
      LastPoint.Perform(WM_SYSCOMMAND, $F012, 0);
      if t <> LastPoint.Top then begin
        ReCalcData;
      end;
    end;
  end;
  NoMouse := False;
end;

procedure TGradBuilder.TemplatePanelMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  TPanel(Sender).Left := 5;
  TPanel(Sender).Width := Panel2.Width - 10;
end;

procedure TGradBuilder.Changecolor1Click(Sender: TObject);
begin
  ColorDialog1.Color := LastPoint.Color;
  if ColorDialog1.Execute then begin
    LastPoint.Color := ColorToRGB(ColorDialog1.Color);
    ReCalcData;
  end;
end;

procedure TGradBuilder.PopupMenu1Popup(Sender: TObject);
begin
  if LastPoint = nil then Exit;
  Delete1.Enabled := (LastPoint.Name <> 'FirstPoint') and (LastPoint.Name <> 'LastPoint');
end;

procedure TGradBuilder.Delete1Click(Sender: TObject);
begin
  if LastPoint = nil then Exit;
  DeleteFromArray(LastPoint);
  ReCalcData;
end;

procedure TGradBuilder.PaintBox1Paint(Sender: TObject);
var
  b : TBitMap;
begin
  b := TBitmap.Create;
  b.Width := PaintBox1.Width;
  b.Height := PaintBox1.Height;
  b.PixelFormat := pf24bit;
  try
    PaintGradV(b, Rect(0, 0, b.Width, b.Height), g);
    PaintBox1.Canvas.Draw(0, 0, b);
  finally
    FreeAndNil(b);
  end;
end;

procedure TGradBuilder.FormShow(Sender: TObject);
begin
  ReCalcData;
  if Assigned(CurrentGradient) and (Length(CurrentGradient.FGradArray) > 0) then begin
    ComboBox1.ItemIndex := CurrentGradient.FGradArray[0].Mode1
  end
  else if (CurrentArray <> nil) and (Length(CurrentArray) > 0) then begin
   ComboBox1.ItemIndex := CurrentArray[0].Mode1;
  end
  else ComboBox1.ItemIndex := 0;
end;

procedure TGradBuilder.BitBtn1Click(Sender: TObject);
begin
  Close;              
end;

function TGradBuilder.AsString: string;
var
  i : integer;
begin
  Result := '';
  for i := 0 to Length(g) - 1 do begin
    Result := Result + IntToStr(ColorToRGB(g[i].Color1)) + ';' +
                       IntToStr(ColorToRGB(g[i].Color2)) + ';' +
                       IntToStr(g[i].Percent) + ';' +
                       IntToStr(g[i].Mode1) + ';' +
                       IntToStr(g[i].Mode2) + ';';
  end;
  Delete(Result, Length(Result), 1);
end;

procedure TGradBuilder.LoadFromArray(NewArray: TsGradArray);
var
  i, c : integer;
  h : integer;
begin
  if Length(NewArray) < 2 then Exit;
  h := 0;
  c := Length(NewArray);

  ComboBox1.ItemIndex := NewArray[0].Mode1;
  for i := 0 to Panel2.ComponentCount - 1 do begin
    if Panel2.Components[i].Name = 'FirstPoint' then begin
      TGradPoint(Panel2.Components[i]).Color := ColorToRGB(NewArray[0].Color1);
    end
    else if Panel2.Components[i].Name = 'LastPoint' then begin
      TGradPoint(Panel2.Components[i]).Color := ColorToRGB(NewArray[c - 1].Color2);
    end;
  end;
  for i := 1 to c - 2 do begin
    inc(h, NewArray[i - 1].Percent * 2);
    SetLength(a, Length(a) + 1);
    NewPoint(Panel2, h, ColorToRGB(NewArray[i].Color1));
  end;
  ReCalcData;
end;

procedure TGradBuilder.TemplatePanelMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  ReCalcData;
end;

procedure TGradBuilder.TemplatePanelDblClick(Sender: TObject);
begin
  LastPoint := TGradPoint(Sender);
  NoMouse := True;
  ColorDialog1.Color := LastPoint.Color;
  if ColorDialog1.Execute then begin
    LastPoint.Color := ColorToRGB(ColorDialog1.Color);
    ReCalcData;
  end;
end;

procedure TGradBuilder.ComboBox1Change(Sender: TObject);
var
  i : integer;
begin
  for i := 0 to Length(g) - 1 do begin
    g[i].Mode1 := ComboBox1.ItemIndex;
  end;
  if Assigned(CurrentGradient) then
    CurrentGradient.Data := AsString;
end;

procedure TGradBuilder.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = 13 then Close;
end;

end.