bitmapprop.pas

强大的皮肤控件 能做出美观的界面

unit BitmapProp;

interface

{$I SkinBuilderInc.inc}

uses
  Windows, Forms, SysUtils, TypInfo, Graphics, Messages, ExtCtrls, StdCtrls,
  Controls, Classes, ComCtrls, KsSkinObjects, se_controls;

type
  TfrmBitmapEditor = class(TForm)
    BmpList: TListBox;
    Label1: TLabel;
    ScrollBox1: TScrollBox;
    BmpView: TPaintBox;
    GroupBox1: TGroupBox;
    Panel1: TPanel;
    Label3: TLabel;
    cbZoom: TComboBox;
    Button1: TButton;
    edRect: TEdit;
    cbAll: TCheckBox;
    Button2: TButton;
    PosLabel: TPanel;
    SizeLabel: TPanel;
    procedure BmpViewMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure cbZoomChange(Sender: TObject);
    procedure BmpViewPaint(Sender: TObject);
    procedure BmpListClick(Sender: TObject);
    procedure BmpViewMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure cbAllClick(Sender: TObject);
  private
    FSkinObject: TSeSkinObject;
    FPropertyData: TSeBitmapLink;
    FScale: integer;
    FP, SP: TPoint;
    procedure BuildList;
    procedure UpdatePaint;
    procedure SetBitmapProperty;
    procedure SetControls;
  public
  end;

var
  frmBitmapEditor: TfrmBitmapEditor;

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

{$R *.DFM}

uses
  {$IFDEF ZP_COMPILER6} DesignIntf, DesignEditors {$ELSE} DsgnIntf {$ENDIF};

{ TfrmBitmapEditor }

procedure TfrmBitmapEditor.FormCreate(Sender: TObject);
begin
  cbZoom.ItemIndex := 0;
  FScale := 1;
end;

procedure TfrmBitmapEditor.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  Action := caHide;
end;

procedure TfrmBitmapEditor.BuildList;
var
  i: integer;
begin
  BmpList.Items.Clear;

  if FSkinObject = nil then Exit;
  if FSkinObject.Bitmaps = nil then Exit;

  for i := 0 to FSkinObject.Bitmaps.Count-1 do
    BmpList.Items.Add(FSkinObject.Bitmaps[i].Name);
end;

procedure TfrmBitmapEditor.UpdatePaint;
begin
  if (FSkinObject.Bitmaps <> nil) and
     (FSkinObject.Bitmaps[BmpList.ItemIndex] <> nil) then
  with FSkinObject.Bitmaps[BmpList.ItemIndex] do
  begin
    BmpView.Width := Width * FScale;
    BmpView.Height := Height * FScale;
  end;
  BmpViewPaint(Self);
end;

procedure TfrmBitmapEditor.SetBitmapProperty;
begin
  if FPropertyData = nil then Exit;
  if FSkinObject = nil then Exit;
  if (FSkinObject.Bitmaps = nil) then Exit;
  if (FSkinObject.Bitmaps[BmpList.ItemIndex] = nil) then Exit;
  { Set object property }
  if cbAll.Checked then
  begin
    FPropertyData.Bitmap := FSkinObject.Bitmaps[BmpList.ItemIndex];
    FPropertyData.Name := FPropertyData.Bitmap.Name;
    FPropertyData.Rect := Rect(0, 0, FPropertyData.Bitmap.Width, FPropertyData.Bitmap.Height);
  end
  else
  begin
    FPropertyData.Bitmap := FSkinObject.Bitmaps[BmpList.ItemIndex];
    FPropertyData.Name := FPropertyData.Bitmap.Name;
    FPropertyData.Rect := Rect(FP.X, FP.Y, SP.X+1, SP.Y+1);
  end;
end;

procedure TfrmBitmapEditor.SetControls;
begin
  if FPropertyData = nil then Exit;
  if FSkinObject = nil then Exit;
  if (FSkinObject.Bitmaps = nil) then Exit;
  if FPropertyData.Bitmap = nil then Exit;

  FP := Point(0, 0);
  SP := Point(0, 0);
  BmpView.Width := 10;
  BmpView.Height := 10;

  if FPropertyData.Name <> '' then
  begin
    BmpList.ItemIndex := BmpList.Items.IndexOf(FPropertyData.Name);

    FP := FPropertyData.Rect.TopLeft;
    SP := FPropertyData.Rect.BottomRight;

    if (SP.X = FPropertyData.Bitmap.Width) and (SP.Y = FPropertyData.Bitmap.Height) then
      cbAll.Checked := true
    else
      cbAll.Checked := false;

    Dec(SP.X);
    Dec(SP.Y);

    edRect.Text := '('+IntToStr(FP.X)+':'+IntToStr(FP.Y)+')-('+
      IntToStr(SP.X)+':'+IntToStr(SP.Y)+')';
    SizeLabel.Caption := 'Size: (' + IntToStr(SP.X - FP.X + 1) + ':' + IntToStr(SP.Y - FP.Y + 1) + ')';

    BmpListClick(Self);
  end;
end;

procedure TfrmBitmapEditor.BmpViewMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
  PosLabel.Caption := 'Position: (' + IntToStr(Trunc(X / FScale)) + ':' + IntToStr(Trunc(Y / FScale)) + ')';
end;

procedure TfrmBitmapEditor.cbZoomChange(Sender: TObject);
begin
  case cbZoom.ItemIndex of
    0: FScale := 1;
    1: FScale := 2;
    2: FScale := 4;
    3: FScale := 8;
  else
    FScale := 1;
  end;
  UpdatePaint;
end;

procedure TfrmBitmapEditor.BmpViewPaint(Sender: TObject);
var
  DstRect: TRect;
  B: TBitmap;
begin
  { Paint }
  if (FSkinObject.Bitmaps <> nil) and
     (FSkinObject.Bitmaps[BmpList.ItemIndex] <> nil) then
  with FSkinObject.Bitmaps[BmpList.ItemIndex] do
  begin
    B := TBitmap.Create;
    try
      B.Width := Width;
      B.Height := Height;
      Draw(B.Canvas.Handle, 0, 0);
      DstRect := Rect(0, 0, Width * FScale, Height * FScale);

      if not cbAll.Checked then
        { Draw lines }
        with B.Canvas do
        begin
          Pen.Mode := pmXor;
          Pen.Color := clLime;
          Pen.Style := psDot;
          MoveTo(FP.X, FP.Y);
          LineTo(FP.X, Height);
          MoveTo(FP.X+1, FP.Y);
          LineTo(Width, FP.Y);

          Pen.Mode := pmXor;
          Pen.Color := clYellow;
          Pen.Style := psDot;
          MoveTo(SP.X, 0);
          LineTo(SP.X, SP.Y);
          MoveTo(0, SP.Y);
          LineTo(SP.X-1, SP.Y);
        end;
      {}
      BmpView.Canvas.StretchDraw(DstRect, B);
    finally
      B.Free;
    end;
  end;
end;

procedure TfrmBitmapEditor.BmpListClick(Sender: TObject);
begin
  { Cahnge image }
  UpdatePaint;
end;

procedure TfrmBitmapEditor.BmpViewMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  { Select Rect}
  if cbAll.Checked then Exit;
  
  if Button = mbLeft then
    FP := Point(Trunc(X / FScale), Round(Y / FScale));
  if Button = mbRight then
    SP := Point(Trunc(X / FScale), Round(Y / FScale));

  edRect.Text := '('+IntToStr(FP.X)+':'+IntToStr(FP.Y)+')-('+
    IntToStr(SP.X)+':'+IntToStr(SP.Y)+')';

  SizeLabel.Caption := 'Size: (' + IntToStr(SP.X - FP.X + 1) + ':' + IntToStr(SP.Y - FP.Y + 1) + ')';

  BmpViewPaint(Self);
end;

procedure TfrmBitmapEditor.Button1Click(Sender: TObject);
begin
  SetBitmapProperty;
  Close;
end;

procedure TfrmBitmapEditor.Button2Click(Sender: TObject);
begin
  Close;
end;

procedure TfrmBitmapEditor.cbAllClick(Sender: TObject);
begin
  UpdatePaint;
end;

{ Eroperty editor =============================================================}

type

  TBitmapPropertyEditor = class(TClassProperty)
  public
    procedure Edit; override;
    function GetAttributes: TPropertyAttributes; override;
    function GetValue: String; override;
  end;

{ TBitmapPropertyEditor }

procedure TBitmapPropertyEditor.Edit;
begin
  if PropCount <> 1 then Exit;

  if frmBitmapEditor = nil then
    frmBitmapEditor := TfrmBitmapEditor.Create(Application);

  frmBitmapEditor.FSkinObject := TSeSkinObject(GetComponent(0));
  frmBitmapEditor.BuildList;
  if Pointer(GetOrdValue) <> nil then
  begin
    frmBitmapEditor.FPropertyData := TSeBitmapLink(Pointer(GetOrdValue));
    frmBitmapEditor.SetControls;
  end;
  frmBitmapEditor.Show;
end;

function TBitmapPropertyEditor.GetAttributes: TPropertyAttributes;
begin
  Result := [paDialog, paReadOnly];
end;

function TBitmapPropertyEditor.GetValue: String;
begin
  Result := '(Bitmap)';
end;

initialization
  RegisterPropertyEditor(TypeInfo(TSeBitmapLink), nil, 'Bitmap', TBitmapPropertyEditor);
finalization
end.