openbitmap.pas

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

unit OpenBitmap;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  se_controls, ExtDlgs, StdCtrls, ExtCtrls, Buttons;

type
  TfrmOpenBitmap = class(TForm)
    OpenImage: TOpenPictureDialog;
    Label1: TLabel;
    ScrollBox1: TScrollBox;
    SrcImg: TImage;
    Label2: TLabel;
    ScrollBox2: TScrollBox;
    DstPaint: TPaintBox;
    Button1: TButton;
    Button2: TButton;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    ScaleLabel: TLabel;
    GroupBox1: TGroupBox;
    MaskPanel: TPanel;
    Label3: TLabel;
    edR: TEdit;
    edG: TEdit;
    Label4: TLabel;
    edB: TEdit;
    Label5: TLabel;
    SpeedButton3: TSpeedButton;
    CurColor: TPanel;
    btnLoad: TBitBtn;
    procedure btnLoadClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure DstPaintPaint(Sender: TObject);
    procedure SrcImgMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure SrcImgMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure SpeedButton3Click(Sender: TObject);
  private
    { Private declarations }
    FBitmap: TSeBitmap;
    FScale: integer;
    procedure UpdateBitmaps;
    procedure ApplyMask(MaskColor: TKColorRec);
  public
    { Public declarations }
  end;

var
  frmOpenBitmap: TfrmOpenBitmap;

function OpenSkinBitmap: TSeBitmap;

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

{$R *.DFM}

function OpenSkinBitmap: TSeBitmap;
var
  i, j: integer;
  C: PKColor;
begin
  Result := nil;

  frmOpenBitmap := TfrmOpenBitmap.Create(Application);
  try
    if frmOpenBitmap.ShowModal = mrOk then
    begin
      Result := frmOpenBitmap.FBitmap;
      { convert A=0 to 255,0,255,0 }
      for i := 0 to Result.Width-1 do
        for j := 0 to Result.Height-1 do
        begin
          C := @Result.Bits[i + j * Result.Width];
          if TKColorRec(C^).A = 0 then
            C^ := KColor(255,0,255,0);
        end;
    end;
  finally
    frmOpenBitmap.Free;
  end;
end;

{ TfrmOpenBitmap }

procedure TfrmOpenBitmap.FormCreate(Sender: TObject);
begin
  FScale := 1;
  FBitmap := TSeBitmap.Create;
end;

procedure TfrmOpenBitmap.btnLoadClick(Sender: TObject);
var
  Picture: TPicture;
begin
  if OpenImage.Execute then
  begin
    Picture := TPicture.Create;
    try
      Picture.LoadFromFile(OpenImage.FileName);
      { }
      FBitmap.Assign(Picture);
      FBitmap.Name := ExtractFileName(OpenImage.FileName);

      with SrcImg.Picture.Bitmap do
      begin
        Width := FBitmap.Width;
        Height := FBitmap.Height;
        FBitmap.Draw(Canvas.Handle, 0, 0);
      end;

      UpdateBitmaps;
    finally
      Picture.Free;
    end;
  end;
end;

procedure TfrmOpenBitmap.Button2Click(Sender: TObject);
begin
  FBitmap.Free;
end;

procedure TfrmOpenBitmap.DstPaintPaint(Sender: TObject);
const
  Colors: array [Boolean] of TKColor = ($FFFFFFFF, $FFB0B0B0);
var
  Cache: TSeBitmap;
  i, j: integer;
begin
  { Paint }
  with FBitmap do
  begin
    Cache := TSeBitmap.Create;
    try
      Cache.SetSize(FBitmap.Width, FBitmap.Height);
      { Draw background }
      for i := 0 to FBitmap.Width-1 do
        for j := 0 to FBitmap.Height-1 do
          Cache.Pixels[i, j] := Colors[Odd(i div 8 + j div 8)];
      { Draw }
      FBitmap.Blend := true;
      FBitmap.Draw(Cache, 0, 0);
      { Draw }
      Cache.Draw(DstPaint.Canvas.Handle, DstPaint.ClientRect, Rect(0, 0, FBitmap.Width, FBitmap.Height));
    finally
      Cache.Free;
    end;
  end;
end;

procedure TfrmOpenBitmap.SrcImgMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
  X := Round(X / FScale);
  Y := Round(Y / FScale);

  if (X < 0) or (Y < 0) then Exit;
  if (X >= FBitmap.Width) or (Y >= FBitmap.Height) then Exit;

  CurColor.Color := KColorToColor(FBitmap.Pixels[X, Y]);
end;

procedure TfrmOpenBitmap.SrcImgMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  X := Round(X / FScale);
  Y := Round(Y / FScale);

  if (X < 0) or (Y < 0) then Exit;
  if (X >= FBitmap.Width) or (Y >= FBitmap.Height) then Exit;

  { Select Mask }
  ApplyMask(TKColorRec(FBitmap.Pixels[X, Y]));

  DstPaintPaint(Self);
end;

procedure TfrmOpenBitmap.SpeedButton1Click(Sender: TObject);
begin
  if FScale > 1 then FScale := FScale - 1;
  UpdateBitmaps;
end;

procedure TfrmOpenBitmap.SpeedButton2Click(Sender: TObject);
begin
  FScale := FScale + 1;
  UpdateBitmaps;
end;

procedure TfrmOpenBitmap.UpdateBitmaps;
begin
  ScaleLabel.Caption := IntToStr(FScale) + '00%';

  DstPaint.Width := FBitmap.Width * FScale;
  DstPaint.Height := FBitmap.Height * FScale;
  DstPaint.Invalidate;

  SrcImg.Width := SrcImg.Picture.Width * FScale;
  SrcImg.Height := SrcImg.Picture.Height * FScale;
end;

procedure TfrmOpenBitmap.ApplyMask(MaskColor: TKColorRec);
var
  C: TKColorRec;
  i, j: integer;
begin
  MaskPanel.Color := RGB(MaskColor.R, MaskColor.G, MaskColor.B);
  edR.Text := IntToStr(MaskColor.R);
  edG.Text := IntToStr(MaskColor.G);
  edB.Text := IntToStr(MaskColor.B);

  FBitmap.SetAlpha($FF);

  for i := 0 to FBitmap.Width-1 do
    for j := 0 to FBitmap.Height-1 do
    begin
      C := TKColorRec(FBitmap.Pixels[i, j]);
      if (C.R = MaskColor.R) and (C.G = MaskColor.G) and (C.B = MaskColor.B) then
        C.A := 0;
      FBitmap.Pixels[i, j] := TKColor(C);
    end;

  UpdateBitmaps;
end;

procedure TfrmOpenBitmap.SpeedButton3Click(Sender: TObject);
var
  C: TKColorRec; 
begin
  C.R := StrToInt(edR.Text);
  C.G := StrToInt(edG.Text);
  C.B := StrToInt(edB.Text);
  { Apply mask }
  ApplyMask(C);
end;

end.