图片 2

delphi 状态栏上放多个进程条

Delphi
中TStatusbar上通常不允许放其它组件。但是经常有需求要在右下角的状态栏上放置进程条以达到更好的显示效果,下面介绍如何将多个进程条组件添加到一个状态栏
TStatusbar上,以及如何适应状态栏的大小来调整进程条的大小。

procedure ChangeBmpBackGround(bmp: TBitmap;ChangeToBack: TColor;const
ColorOffset: Byte = 0);
var
  i,j,Count: integer;
  RColor,GColor,BColor: Byte;
  TRColor,TGColor,TBColor: Byte;
  p: PByteArray;
begin
  bmp.PixelFormat := pf32bit;
  TColorToRGB(bmp.Canvas.Pixels[0,0],RColor,GColor,BColor);
  TColorToRGB(ChangeToBack,TRColor,TGColor,TBColor);
  count := 4 * bmp.Width – 1;
  for i := 0 to bmp.Height – 1 do
  begin
    j := 0;
    p := bmp.ScanLine[i];
    while j < count do
    begin
      if (abs(p[j] – BColor)<=ColorOffset) and (abs(p[j+1] –
GColor) <= ColorOffset)and (abs(p[j+2] –
RColor)<=ColorOffset) then
      begin
         p[j] := TBColor;
         P[j+1] := TGColor;
         p[j+2] := TRColor;
      end;
      inc(j,4);
    end;
  end;
end;

interface

图片 1

{——————————————————————————-
  过程名:    TColorToRGB
  作者:      不得闲
  日期:      2009.02.11
  参数:      const Color: TColor; var R, G, B: Byte
  返回值:    无
  用途:     获得颜色的RGB值
——————————————————————————-}

procedure TColorToRGB(const Color: TColor; var R, G, B: Byte);
var
  C: Integer;
begin
  C := ColorToRGB(Color);
  R := C and $FF;
  G := (C shr 8) and $FF;
  B := (C shr 16) and $FF;
end;
{——————————————————————————-
  过程名:    HeCheng
  作者:      不得闲
  日期:      2009.02.11
  参数:      A,b: 指定合成位图
            TransPercent: 设置透明度
            ignoreColor:  设置合成时忽略的颜色
            ColorOffset:  透明色的边缘色差(在该色差内的颜色都将忽略掉)

    lsbLeft.ItemIndex := 0;
    lsbLeft.Repaint();
end;

unit Unit1; interface uses  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,  Dialogs,commctrl, ComCtrls, StdCtrls; type  TForm1 = class(TForm)    StatusBar1: TStatusBar;    ProgressBar1: TProgressBar;    ProgressBar2: TProgressBar;    Button1: TButton;    procedure FormShow(Sender: TObject);    procedure Button1Click(Sender: TObject);  private    { Private declarations }  public    { Public declarations }  end; var  Form1: TForm1; implementation {$R *.dfm} procedure TForm1.FormShow(Sender: TObject);var  r,r2: TRect;begin  //状态栏可以自定义为多个panel,我们首先要取得放进程条在那个panel的尺寸大小  //以下函数需要引用 单元 commctrl  //第二个参数中 0是取得状态栏第一个panel 依次 1为取得第二个panel  Statusbar1.Perform(SB_GETRECT, 0, Integer(@R));  Statusbar1.Perform(SB_GETRECT, 2, Integer(@R2));  //我们设定在状态栏放两个进程条,分别放在第一个与第三个panel中,当然状态栏你要先设好为三个   //设置进程控件的parent为状态栏,即可将进程条放在状态栏上  progressbar1.Parent := Statusbar1;  progressbar2.Parent := Statusbar1;   //设置第一个进程条在状态栏第一个panel的位置  progressbar1.Top    := r.Top;      //set size of  progressbar1.Left   := r.Left;      //Progressbar to  progressbar1.Width  := r.Right - r.Left; //fit with panel  progressbar1.Height := r.Bottom - r.Top;   //设置第二个进程条在状态栏第三个个panel的位置  progressbar2.Top    := r2.Top;      //set size of  progressbar2.Left   := r2.Left;      //Progressbar to  progressbar2.Width  := r2.Right - r2.Left; //fit with panel  progressbar2.Height := r2.Bottom - r2.Top;  //以上我们设定进程条充满各自的panel,当然你可以设定进程条的top,left等属性来调整显示位置  end;procedure TForm1.Button1Click(Sender: TObject);var  i:integer;begin for i:=0 to 100 do begin    Sleep(100);    ProgressBar1.Position:=i;    ProgressBar2.Position:=i;    end;end; end.

今天在公司由于要用到一个图片遮罩的效果,于是按照同样的思路写了一个图像遮罩函数:

end.

  MinBegin := 4 * ((MaxWidth – MinWidth) Div 2);
  count := 4 * (MaxWidth-(MaxWidth – MinWidth) Div 2 – 1);

 
文章为作者原创,转载前请先与本人联系,转载请注明文章出处、保留作者信息,谢谢支持!
=========================================================================}

procedure
 TForm1.FormCreate(Sender: TObject);
var
    i: integer;
begin
    lsbRight.Style := lbOwnerDrawFixed;
    lsbRight.Ctl3D := false;
    lsbRight.ItemHeight := 50;
    lsbRight.Items.Add(‘C++ Builder
研究 致力于BCB的学习探讨和研究’#13’ccrun(老妖)’);
    lsbRight.Items.Add(‘编程手札 My
Developer Knowledge
Base’#13”);
    for i:=3 to 10 do begin
        lsbRight.Items.Add(‘ListBox Items
of ‘ + IntTostr(i) + #13’Second
of ‘
            + IntToStr(i) + #13’Third
of ‘ + IntToStr(i));
    end;

//状态栏可以自定义为多个panel,我们首先要取得放进程条在那个panel的尺寸大小
//以下函数需要引用 单元 commctrl
//第二个参数中 0是取得状态栏第一个panel 依次 1为取得第二个panel
Statusbar1.Perform(SB_GETRECT, 0, Integer(@R),’,’,’);
Statusbar1.Perform(SB_GETRECT, 2, Integer(@R2),’,’,’);
//我们设定在状态栏放两个进程条,分别放在第一个与第三个panel中,当然状态栏你要先设好为三个

*            SoftPercent指定遮罩度(取1-100,100为完全遮罩)
*

procedure TForm1.lsbRightDrawItem(Control:
TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
var
    strTemp: String;
begin
    //文字颜色
    lsbRight.Canvas.Font.Color := clBlack;
    //设置背景颜色并填充背景
    lsbRight.Canvas.Brush.Color := clWhite;
    lsbRight.Canvas.FillRect (Rect);
   
//设置圆角矩形颜色并画出圆角矩形
    lsbRight.Canvas.Brush.Color := TColor($00FFF7F7);
    lsbRight.Canvas.Pen.Color := TColor($00131315);
    lsbRight.Canvas.RoundRect(Rect.Left + 3, Rect.Top + 3,
            Rect.Right – 2,
Rect.Bottom – 2, 8, 8);
   
//以不同的宽度和高度再画一次,实现立体效果
    lsbRight.Canvas.RoundRect(Rect.Left + 3, Rect.Top + 3,
            Rect.Right – 3,
Rect.Bottom – 3, 5, 5);
    //如果是当前选中项
    if(odSelected in State) then
    begin
       
//以不同的背景色画出选中项的圆角矩形
        lsbRight.Canvas.Brush.Color := TColor($00FFB2B5);
        lsbRight.Canvas.RoundRect(Rect.Left + 3, Rect.Top + 3,
                Rect.Right – 3,
Rect.Bottom – 3, 5, 5);
        //选中项的文字颜色
        lsbRight.Canvas.Font.Color := clBlue;
       
//如果当前项拥有焦点,画焦点虚框,当系统再绘制时变成XOR运算从而达到擦除焦点虚框的目的
        if(odFocused in State) then DrawFocusRect(lsbRight.Canvas.Handle,
Rect);
    end;
    //画出图标
    ImageList1.Draw(lsbRight.Canvas, Rect.Left + 7,
            Rect.top + (lsbRight.ItemHeight –
ImageList1.Height) div 2,
Index, true);
    //分别绘出三行文字
    strTemp := lsbRight.Items.Strings[Index];
    lsbRight.Canvas.TextOut(Rect.Left + 32 + 10, Rect.Top + 4
                            , Copy(strTemp, 1, Pos(#13,
strTemp)-1));
    strTemp := Copy(strTemp, Pos(#13, strTemp)+1, Length(strTemp));
    lsbRight.Canvas.TextOut(Rect.Left + 32 + 10, Rect.Top + 18,
                            Copy(strTemp, 1, Pos(#13, strTemp)-1));
    lsbRight.Canvas.TextOut(Rect.Left + 32 + 10, Rect.Top + 32,
                            Copy(strTemp, Pos(#13, strTemp)+1, Length(strTemp)));
end;

//设置进程控件的parent为状态栏,即可将进程条放在状态栏上
progressbar1.Parent := Statusbar1;
progressbar2.Parent := Statusbar1;

 

type
  TForm1 = class(TForm)
    lsbRight: TListBox;
    ImageList1: TImageList;
    StaticText1: TStaticText;
    lsbLeft: TListBox;
    imgHouse: TImage;
    imgHouseGray: TImage;
    procedure FormCreate(Sender: TObject);
    procedure lsbRightDrawItem(Control: TWinControl; Index:
Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure lsbRightClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure lsbLeftDrawItem(Control: TWinControl; Index:
Integer;
      Rect: TRect; State: TOwnerDrawState);
  private

 

 本文利用Listbox自绘实现了两种特殊效果(见图),左边的风格是自己突然灵感触发想到的,右边的风格来自"C++ Builder 研究"的一个帖子,老妖用BCB实现了,这里则用Delphi实现它。

//设置第一个进程条在状态栏第一个panel的位置
progressbar1.Top := r.Top; //set size of
progressbar1.Left := r.Left; //Progressbar to
progressbar1.Width := r.Right – r.Left; //fit with panel
progressbar1.Height := r.Bottom – r.Top;

  MinBegin := 4 * ((MaxWidth – MinWidth) Div 2);
  count := 4 * (MaxWidth-(MaxWidth – MinWidth) Div 2 – 1);

//设置第二个进程条在状态栏第三个个panel的位置
progressbar2.Top := r2.Top; //set size of
progressbar2.Left := r2.Left; //Progressbar to
progressbar2.Width := r2.Right – r2.Left; //fit with panel
progressbar2.Height := r2.Bottom – r2.Top;
//以上我们设定进程条充满各自的panel,当然你可以设定进程条的top,left等属性来调整显示位置

 

procedure TForm1.FormShow(Sender:
TObject);
begin
    lsbRight.ItemIndex := 0;
    lsbRight.Repaint();

存储的方式为 BGRL,所以,总的字节数应该是 4*宽度

演示图片:
图片 2

{作者:不得闲

//————————————————————————–

 

{========================================================================
  DESIGN BY :  彭国辉
  DATE:        2004-11-29
  SITE:        http://kacarton.yeah.net/
  BLOG:        http://blog.csdn.net/nhconch
  EMAIL:       kacarton#sohu.com

在加一个透明图画法的函数,效果不大好

var
  Form1: TForm1;

  MinHeight := Min(A.Height,B.Height);
  MinWidth := Min(A.Width,B.Width);
  MaxWidth := Max(A.Width,B.Width);

    lsbLeft.Style :=
lbOwnerDrawFixed;
    lsbLeft.Ctl3D := false;
    lsbLeft.ItemHeight := 90;
    lsbLeft.Items.Add(‘编程手札’);
    lsbLeft.Items.Add(‘My Developer
Knowledge Base’);
    lsbLeft.Items.Add(‘站长:天蝎蝴蝶’);
    lsbLeft.Items.Add(”);
end;

procedure TransparentDraw(DestCanvas: TCanvas;DestRect: TRect;Graphic:
TBitmap;const ColorOffset: Byte=0);
var
  i,j,Count: integer;
  RectH,RectW: integer;
  p: PByteArray;
  RColor,GColor,BColor: Byte;
begin
  //区域高度
  Graphic.PixelFormat := pf32bit;
  RectH := DestRect.Bottom – DestRect.Top;
  if RectH > Graphic.Height then
    RectH := Graphic.Height;
  RectH := DestRect.Top + RectH;
  RectW := DestRect.Right – DestRect.Left;
  TColorToRGB(Graphic.Canvas.Pixels[0,0],RColor,GColor,BColor);
  if RectW > Graphic.Width then
    RectW := Graphic.Width;
  Count := 4*RectW – 1;
  for i := DestRect.Top to RectH – 1 do
  begin
    p := Graphic.ScanLine[i – DestRect.Top];
    j := 0;
    while j < Count do
    begin
      if (abs(p[j] – BColor)<=ColorOffset) and (abs(p[j+1] –
GColor) <= ColorOffset)and (abs(p[j+2] –
RColor)<=ColorOffset) then
        inc(j,4)
      else
      begin
        BColor := p[j];
        GColor := p[j + 1];
        RColor := p[j+2];
        DestCanvas.Pixels[j div 4,i] := RGB(RColor,GColor,BColor);
        inc(j,4);
      end;
    end;
  end;
end;

procedure TForm1.lsbLeftDrawItem(Control:
TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
var
    r: TRect;
begin
    with lsbLeft.Canvas do begin
       
//设置填充的背景颜色并填充背景
        Brush.Color := clWhite;
        FillRect (Rect);
        //绘制圆角矩形
        if (odSelected in State) then   //选中项的圆角矩形颜色
            Pen.Color := $FFB2B5
        else                            //未选中项的圆角矩形颜色
            Pen.Color := clSilver;
        Brush.Style := bsClear;
        SetRect(r, Rect.Left+3,
Rect.Top+3, Rect.Right-3, Rect.Bottom-3);
        RoundRect(r.Left, r.Top, r.Right, r.Bottom, 10, 10);
        //画出图标
        if (odSelected in State) then   //选中项的图像
            Draw(r.Left + (r.Right – r.Left –
imgHouse.Width) shr 1,
                r.Top + 2,
imgHouse.Picture.Graphic)
        else                            //未选中项的图像
            Draw(r.Left + (r.Right – r.Left –
imgHouseGray.Width) shr 1,
                r.Top + 2,
imgHouseGray.Picture.Graphic);
        //填充文字区背景
        r.Top := r.Bottom – Abs(Font.Height) – 4;
        Brush.Style := bsSolid;
        if (odSelected in State) then   //选中项的背景颜色
            Brush.Color := $FFB2B5
        else                            //未选中项的背景颜色
            Brush.Color := clSilver;
        FillRect(r);
        //输出文字,仅支持单行
        Font.Color := clBlack;
        r.Top := r.Top + 2; //计算文字顶点位置,(水平居中,DT_CENTER不可用)
        DrawText(Handle,
PChar(TListBox(Control).Items.Strings[Index]), -1, r
                , DT_CENTER or DT_END_ELLIPSIS{ or DT_WORDBREAK});
       
//画焦点虚框,当系统再绘制时,变成XOR运算,从而达到擦除焦点虚框的目的
        if(odFocused in State) then DrawFocusRect(Rect);
    end;
end;

代码如下:

  public
    { Public declarations }
  end;

      //比较字节的值,位图该点像素的RGB值是否为需要过滤的颜色值,如果是,则过滤掉
      if (abs(p2[j – MinBegin] – BColor)<=ColorOffset) and

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls,
Forms,
  Dialogs, StdCtrls, ImgList, jpeg, ExtCtrls;

于是,随手写的一个函数,具体代码如下:

procedure TForm1.lsbRightClick(Sender:
TObject);
begin
    StaticText1.Caption := ‘ ‘ +
lsbRight.Items.Strings[lsbRight.ItemIndex];
end;

 

{$R *.dfm}

偶然在论坛上看到提问,将图片B合成到图片A上,并且在A上写字

unit DrawListItem;

{——————————————————————————-
  过程名:    TransparentDraw
  作者:      不得闲
  日期:      2009.02.12
  参数:      DestCanvas: 目标画布
             DestRect: 目标区域
             Graphic: 位图
             ColorOffset
背景色附近的颜色差值,在该差值之内的颜色,都会被透明掉
  返回值:    无
——————————————————————————-}

implementation

{——————————————————————————-
  过程名:    SoftBmp
  作者:      不得闲
  日期:      2009.02.13
  参数:      bmp: TBitmap;
            DarkRect: 不遮罩的区域
            SoftColor:指定遮罩色

同时,也写下了一个更换图片背景色的函数,代码如下:

 

  for i := 0 to MinHeight – 1 do
  begin
    if MinHeight = B.Height then
    begin
      p1 := A.ScanLine[i];
      p2 := B.ScanLine[i];
    end
    else
    begin
      p1 := B.ScanLine[i];
      p2 := A.ScanLine[i];
    end;
    j := MinBegin;
    while j < count do
    begin

 

function HeCheng(A,b:TBitmap;const TransPercent: integer=50):TBitmap;
var
  i,j: integer;
  p1,p2: PByteArray;
  count,MinBegin: Integer;
  MinHeight: integer;
  MinWidth,MaxWidth: Integer;
  r: TRect;
begin
  A.PixelFormat := pf32bit;
  b.PixelFormat := pf32bit;

过滤掉白色,也就是RGB分别为255的时候,不处理合成则可。

 

         (abs(p2[j-MinBegin+2]-RColor)<=ColorOffset)  then
        inc(j,4)
      else
      begin
        p1[j] := p1[j] + TransPercent * (p2[j-MinBegin] –
p1[j]) div 100;
        inc(j);
      end;
    end;
  end;
  if MinHeight = B.Height then
  begin
    r.Top := A.Height – A.Canvas.TextHeight(‘你好’)-5;
    r.Bottom := A.Height;
    r.Left := 0;
    r.Right := A.Width;
    A.Canvas.Brush.Style := bsclear;
    windows.DrawText(A.Canvas.Handle,’你好’,-1,r,DT_Center or
DT_VCenter or DT_SIngleLine);
    Result := A;
  end
  else
  begin
    r.Top := B.Height – B.Canvas.TextHeight(‘你好’)-5;
    r.Bottom := B.Height;
    r.Left := 0;
    r.Right := B.Width;
    B.Canvas.Brush.Style := bsclear;
    windows.DrawText(B.Canvas.Handle,’你好’,-1,r,DT_Center or
DT_VCenter or DT_SIngleLine);
    Result := B;
  end;
end;

由上面我们又可以引申一个函数,可以用来过滤任何颜色的,也就是说,指定一个颜色,只要图片中含有该颜色的区域就过滤掉,比如,图片B中含有红蓝两色,此时设置一个红色过滤色,哪么合成之后B图中的红色被过滤掉

* 2009-02-11}*

 

这里,我先将位图A和B都转化成了pf32bit,此时每个位图的每个像素点由4个字节存储

比如,现在要透明一个图片合成上去

代码如下:

procedure SoftBmp(bmp: TBitmap;var DarkRect: TRect;const SoftColor:
TColor;const SoftPercent: Integer=50);
var
  i,j : integer;
  pB : PByteArray;
  BmpFormatXs: Integer;
  w,h:Integer;
  R,G,B: Integer;
begin
  if bmp.PixelFormat <> pf32bit then  
    bmp.PixelFormat := pf32bit;
  BmpFormatXs := 4;

  w:= DarkRect.Right – DarkRect.Left;
  h:= DarkRect.Bottom – DarkRect.Top;
  
  if DarkRect.Right > bmp.Width then
  begin
    DarkRect.Left:=bmp.Width – w;
    DarkRect.Right:=bmp.Width;
  end;
  if (DarkRect.Bottom > bmp.Height) then
  begin
    DarkRect.Top:= bmp.Height – h;
    DarkRect.Bottom:=bmp.Height;
  end;
  if DarkRect.Left <0 then
  begin
    DarkRect.Left:=0;
    DarkRect.Right:=w;
  end;
  if DarkRect.Top <0 then
  begin
    DarkRect.Top:=0;
    DarkRect.Bottom:=h;
  end;
  TColorToRGB(SoftColor,R,G,B);
  for i := 0 to DarkRect.Top – 1 do
  begin
    pb:=bmp.ScanLine[i];
    j := 0;
    while j < BmpFormatXs*bmp.Width – 1 do
    begin
      pb[j] := B + (100-SoftPercent) * (pb[j] – B) div 100;
      pb[j+1] := G + (100-SoftPercent) * (pb[j+1] – G) div 100;
      pb[j+2] := R + (100-SoftPercent) * (pb[j+2]-R) div 100;
      inc(j,BmpFormatXs);
    end;
  end;

*  返回值:    TBitmap
  用途:     合成两张位图
——————————————————————————-}*
function HeCheng(A,b:TBitmap;const TransPercent: integer=50;const
ignoreColor: TColor = clwhite;Const ColorOffset: byte=0):TBitmap;
var
  i,j: integer;
  p1,p2: PByteArray;
  count,MinBegin: Integer;
  MinHeight: integer;
  MinWidth,MaxWidth: Integer;
  r: TRect;
  RColor,GColor,BColor: Byte;
begin
  A.PixelFormat := pf32bit;
  b.PixelFormat := pf32bit;
  TColorToRGB(ignoreColor,RColor,GColor,BColor);
  
  MinHeight := Min(A.Height,B.Height);
  MinWidth := Min(A.Width,B.Width);
  MaxWidth := Max(A.Width,B.Width);

  for i := 0 to MinHeight – 1 do
  begin
    if MinHeight = B.Height then
    begin
      p1 := A.ScanLine[i];
      p2 := B.ScanLine[i];
    end
    else
    begin
      p1 := B.ScanLine[i];
      p2 := A.ScanLine[i];
    end;
    j := MinBegin;
    while j < count do
    begin
      if (p2[j – MinBegin] = 255) and (p2[j-MinBegin+1] =
255) and (p2[j-MinBegin+2]=255) then
        inc(j,4)
      else
      begin
        p1[j] := p1[j] + TransPercent * (p2[j-MinBegin] –
p1[j]) div 100;
        inc(j);
      end;
    end;
  end;
  if MinHeight = B.Height then
  begin
    r.Top := A.Height – A.Canvas.TextHeight(‘你好’)-5;
    r.Bottom := A.Height;
    r.Left := 0;
    r.Right := A.Width;
    A.Canvas.Brush.Style := bsclear;
    windows.DrawText(A.Canvas.Handle,’你好’,-1,r,DT_Center or
DT_VCenter or DT_SIngleLine);
    Result := A;
  end
  else
  begin
    r.Top := B.Height – B.Canvas.TextHeight(‘你好’)-5;
    r.Bottom := B.Height;
    r.Left := 0;
    r.Right := B.Width;
    B.Canvas.Brush.Style := bscleae r;
    windows.DrawText(B.Canvas.Handle,’你好’,-1,r,DT_Center or
DT_VCenter or DT_SIngleLine);
    Result := B;
  end;
end;

*  返回值:    无
——————————————————————————-}*

{——————————————————————————-
  过程名:    ChangeBmpBackGround
  作者:      不得闲
  日期:      2009.02.12
  参数:      bmp: TBitmap;
             ChangeToBack: 要修改为的背景色
             ColorOffset
背景色附近的颜色差值,在该差值之内的颜色,也会被修改
  返回值:    无
——————————————————————————-}

 

HeCheng(Image1.Picture.Bitmap,Image4.Picture.Bitmap,100,Image4.Canvas.Pixels[0,0],20);

 

         (abs(p2[j-MinBegin+1] – GColor)<=ColorOffset) and

  for i := DarkRect.Top to bmp.Height – 1 do
  begin
    pb:=bmp.ScanLine[i];
    j := 0;
    while j < BmpFormatXs*DarkRect.Left – 1 do
    begin
      pb[j] := B + (100-SoftPercent) * (pb[j] – B) div 100;
      pb[j+1] := G + (100-SoftPercent) * (pb[j+1] – G) div 100;
      pb[j+2] := R + (100-SoftPercent) * (pb[j+2]-R) div 100;
      inc(j,BmpFormatXs);
    end;
  end;
  for i := DarkRect.Bottom to bmp.Height – 1 do
  begin
    pb:=bmp.ScanLine[i];
    j := BmpFormatXs*DarkRect.Left;
    while j < BmpFormatXs*bmp.Width – 1 do
    begin
      pb[j] := B + (100-SoftPercent) * (pb[j] – B) div 100;
      pb[j+1] := G + (100-SoftPercent) * (pb[j+1] – G) div 100;
      pb[j+2] := R + (100-SoftPercent) * (pb[j+2]-R) div 100;
      inc(j,BmpFormatXs);
    end;
  end;

  for i := DarkRect.Top to DarkRect.Bottom – 1 do
  begin
    pb:=bmp.ScanLine[i];
    j := BmpFormatXs*DarkRect.Right;
    while j < BmpFormatXs*bmp.Width – 1 do
    begin
      pb[j] := B + (100-SoftPercent) * (pb[j] – B) div 100;
      pb[j+1] := G + (100-SoftPercent) * (pb[j+1] – G) div 100;
      pb[j+2] := R + (100-SoftPercent) * (pb[j+2]-R) div 100;
      inc(j,BmpFormatXs);
    end;
  end;
end;

发表评论

电子邮件地址不会被公开。 必填项已用*标注