【delphi开源代码栏目提醒】:以下是网学会员为您推荐的delphi开源代码-abnwin.pas,希望本篇文章对您学习有所帮助。
unit abnwin;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, Menus, ExtDlgs;
type
TForm1 = class(TForm)
Image1: TImage;
Image2: TImage;
PopupMenu1: TPopupMenu;
OpenPictureDialog1: TOpenPictureDialog;
Open1: TMenuItem;
N1: TMenuItem;
Exit1: TMenuItem;
procedure Exit1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormPaint(Sender: TObject);
procedure Open1Click(Sender: TObject);
procedure Image2MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Image2MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Image2MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
newRgn: HRGN;
bitmap: TBitmap;
brush: TBrush;
mousedown: bool;
clickx: integer;
clicky: integer;
{ Private declarations }
public
function GetColorDegree(color: TColor): TColor;
function CreateRgn(rgnBitmap: TBitmap; transColor: TColor): HRGN;
{ Public declarations }
end;
var
Form1: TForm1;
const
comparecolor = $00EAEAEA;
implementation
uses XMconsts;
{$R *.dfm}
function TForm1.GetColorDegree(color: TColor): TColor;
var
r, g, b, c: Integer;
degree: TColor;
begin
c := color;
r := c and $000000FF;
g := c and $0000FF00;
g := Round((g * 1.0) / $100);
b := c and $00FF0000;
b := Round((b * 1.0) / $10000);
degree := Round(r * 0.3 + 0.59 * g + 0.11 * b);
degree := degree * $100 + degree * $10000;
result := degree;
end;
function TForm1.CreateRgn(rgnBitmap: TBitmap; transColor: TColor): HRGN;
var
i, j: Integer;
width, height: Integer;
left, right: Integer;
rectRgn: HRGN;
begin
Result := 0; // Delphi中的0,相当于C++中的NULL,表空指针
width := rgnBitmap.Width;
height := rgnBitmap.Height;
for i := 0 to height - 1 do
begin
left := -1;
for j := 0 to width - 1 do
begin
if left < 0 then
begin
if (GetColorDegree(rgnBitmap.Canvas.Pixels[j, i]) <
GetColorDegree(transColor)) then
left := j;
end
else if (GetColorDegree(rgnBitmap.Canvas.Pixels[j, i]) >=
GetColorDegree(transColor)) then
begin
right := j;
rectRgn := CreateRectRgn(left, i, right, i + 1);
if Result = 0 then
Result := rectRgn
else
begin
CombineRgn(Result, Result, rectRgn, RGN_OR);
DeleteObject(rectRgn);
end;
left := -1;
end;
end;
if left >= 0 then
begin
rectRgn := CreateRectRgn(left, i, width, i + 1);
if Result = 0 then
Result := rectRgn
else
begin
CombineRgn(Result, Result, rectRgn, RGN_OR);
DeleteObject(rectRgn);
end;
end;
end;
end;
procedure TForm1.Exit1Click(Sender: TObject);
begin
Application.Terminate;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
// 取得程序标题
Self.Caption := GetAppTitle(2, True);
bitmap := TBitmap.Create();
mousedown := false;
brush := TBrush.Create();
brush.Bitmap := TBitmap.Create();
bitmap := Image1.Picture.Bitmap;
brush.Bitmap := Image1.Picture.Bitmap;
Form1.Canvas.Brush := brush;
brush.Free();
newRgn := CreateRgn(bitmap, comparecolor);
Form1.Width := bitmap.Width;
Form1.Height := bitmap.Height;
Form1.Canvas.FillRect(Rect(0, 0, bitmap.Width, bitmap.Height));
SetWindowRgn(self.Handle, newRgn, true);
Invalidate();
end;
procedure TForm1.FormPaint(Sender: TObject);
begin
Form1.Canvas.FillRect(Rect(0, 0, bitmap.Width, bitmap.Height));
end;
procedure TForm1.Open1Click(Sender: TObject);
begin
OpenPictureDialog1.Filter := 'bmp files(*.bmp)|*.bmp';
if (OpenPictureDialog1.Execu