picbutton.pas

是一款针对啤酒行业的销售进销存管理系统,包括基本的进货,销售,库存

  Tmp : TBitMap;
  Tmp1:Tbitmap; //2002/12/27
  x,y : integer;
  text : array[0..40] of char;
  Fontheight : integer;
  ///new add variant
  //FromR, FromG, FromB : Integer; //These are the separate color values for RGB
  //DiffR, DiffG, DiffB : Integer; // of color values.
  //rct : TRect;                   //Rectangle used to draw frame around button
  //offset : Integer;              //Used for Caption location during Mouse Down
  //i: integer;

begin
ARect := Rect(0,0,Width,Height);
Canvas.font := font;
FontHeight := Canvas.TextHeight('W');
if not FBitMap.empty then
  begin
  x := (width - FBitMap.width) div 2;
  if caption <> '' then
    y := ((Height - FBitMap.Height- FontHeight) div 2)
  else
   y := ((Height - FBitMap.Height) div 2);
     BRect := rect(x, y, x + FBitMap.width, y + FBitMap.height);
     Tmp := TBitmap.Create;
     Tmp.Height := FBitMap.Height;
     Tmp.Width := FBitMap.Width;
     Tmp.Canvas.CopyRect(ARect, FBitmap.Canvas, ARect);
     if pushed then
      DrawTransparentBitmap( Canvas.Handle, Tmp, x +1, y+1, FBitmap.TransparentColor )
     else
      DrawTransparentBitmap( Canvas.Handle, Tmp, x, y, FBitmap.TransparentColor );
     Tmp.Free;
  end;

  if caption <> '' then
  with Canvas do
  begin
   if  not Transparent then
       Brush.Color:=rgb(0,255,255)
   else
       Brush.Style := bsClear;
       
   with ARect do
    begin
     if Fbitmap.empty then
       Top := ((Bottom + Top) - FontHeight) shr 1
     else
       top := Brect. bottom;
      Bottom := Top + FontHeight;
      if pushed then
        begin
         top := top + 1;
         left := 2;
        end;
    end;
    StrPCopy(Text, Caption);
    DrawText(Handle, Text, StrLen(Text), ARect, (DT_EXPANDTABS or DT_center));
   end;

 ARect := getclientrect;
 case fborder of
 BsNormal : BEGIN
            if pushed then
                frame3d(canvas, ARect ,clBtnShadow,clBtnHighlight, 1)
            else
                frame3d(canvas, ARect ,clBtnHighlight,clBtnShadow, 1);
            END;
 BsIe :  Begin
         if pushed then
            frame3d(canvas, ARect ,clBtnShadow,clBtnHighlight, 1)
         else
          if Fover then
            frame3d(canvas, ARect ,clBtnHighlight,clBtnShadow, 1);
         end;
 BsGrad: begin
          if pushed then
                //frame3d(canvas, ARect ,clBtnShadow,clBtnHighlight, 1)
              begin
                  canvas.Brush.Style:=bsclear;
                  canvas.Pen.Color:=rgb(255,94,32);
                  canvas.RoundRect(Arect.left,Arect.top,Arect.right,Arect.bottom,FXAngle,FYAngle);
                  canvas.Brush.Style:=bsclear;
                  canvas.Pen.Color:=rgb(255,199,142);
                  canvas.RoundRect(Arect.left+1,Arect.top+1,Arect.right-1,Arect.bottom-1,FXAngle,FYAngle);
                  canvas.Brush.Style:=bsclear;
                  canvas.Pen.Color:=rgb(255,229,152);
                  canvas.RoundRect(Arect.left+2,Arect.top+2,Arect.right-2,Arect.bottom-2,FXAngle,FYAngle);
              end
            else

                  begin
                    if not Transparent then
                    begin
                        canvas.Brush.Color:=bitmapBg;
                        //canvas.Pen.width:=2;
                        canvas.Pen.Color:=rgb(0,0,0);
                        canvas.RoundRect(Arect.left,Arect.top,Arect.right,Arect.bottom,FXAngle,FYAngle);
                        canvas.Pen.Color:=rgb(255,255,255);
                        canvas.RoundRect(Arect.left+1,Arect.top+1,Arect.right-1,Arect.bottom-1,FXAngle,FYAngle);
                        //2002/12/27
                         x := (width - FBitMap.width) div 2;
                         y := ((Height - FBitMap.Height) div 2);
                        Tmp1:= TBitmap.Create;
                        Tmp1.Height := FBitMap.Height;
                        Tmp1.Width := FBitMap.Width;
                        Tmp1.Canvas.CopyRect(ARect, FBitmap.Canvas, ARect);
                        DrawTransparentBitmap( Canvas.Handle, Tmp1, x, y, Fbitmap.TransparentColor );
                    end
                    else
                    begin
                        canvas.Brush.Style:=bsclear;
                        //canvas.Pen.width:=2;
                        canvas.Pen.Color:=rgb(0,0,0);
                        canvas.RoundRect(Arect.left,Arect.top,Arect.right,Arect.bottom,FXAngle,FYAngle);
                        canvas.Brush.Style:=bsclear;
                        canvas.Pen.Color:=rgb(255,255,255);
                        canvas.RoundRect(Arect.left+1,Arect.top+1,Arect.right-1,Arect.bottom-1,FXAngle,FYAngle);

                    end;
                  end;
            END;
         
 end; { case}
 ///new add  define
  //Fbitmap.Canvas.Font.Color := Font.Color; //Keep Bitmap in synch with settings.
  //Fbitmap.Canvas.Font := Font;     // Set the Bitmap font to match control font
  //Fbitmap.Width := Width;          //Set BMP dimensions to match control's
  //Fbitmap.Height := Height;
  {rct := Rect(0,0,Width,Height);  //Set rectangle size for later use
  FromR := FBeginCrl and $000000ff;  //Strip out separate RGB values
  FromG := (FBeginCrl  shr 8) and $000000ff;
  FromB := (FBeginCrl  shr 16) and $000000ff;
  DiffR := (FBeginCrl  and $000000ff) - FromR;   //Find the difference
  DiffG := ((FBeginCrl  shr 8) and $000000ff) - FromG;
  DiffB := ((FBeginCrl  shr 16) and $000000ff) - FromB;
  //Depending on gradient style selected, go draw it on the Bitmap canvas.
  case FGradientStyle of
    //gsHorizontal  : DoHorizontal(FromR, FromG, FromB, DiffR, DiffG, DiffB);
    //gsVertical    : DoVertical(FromR, FromG, FromB, DiffR, DiffG, DiffB);
    //gsElliptic    : DoElliptic(FromR, FromG, FromB, DiffR, DiffG, DiffB);
    //gsRectangle   : DoRectangle(FromR, FromG, FromB, DiffR, DiffG, DiffB);
    //gsVertCenter  : DoVertCenter(FromR, FromG, FromB, DiffR, DiffG, DiffB);
    gsHorizCenter : DoHorizCenter(FromR, FromG, FromB, DiffR, DiffG, DiffB);
  end;
  }
end;
//new add func
{
procedure TMTranBtn.DoHorizCenter(fr, fg, fb, dr, dg, db : Integer);
var
  ColorRect: TRect;
  I: Integer;
  R, G, B : Byte;
  Haf : Integer;
begin
  Haf := Width Div 2;
  ColorRect.Top := 0;
  ColorRect.Bottom := Height;
  for I := 0 to Haf do begin
    ColorRect.Left := Muldv (I, Haf, Haf);
    ColorRect.Right := Muldv (I + 1, Haf, Haf);
    R := fr + Muldv(I, dr, Haf);
    G := fg + Muldv(I, dg, Haf);
    B := fb + Muldv(I, db, Haf);
    Canvas.Brush.Color := RGB(R, G, B);
    Canvas.FillRect(ColorRect);
    ColorRect.Left :=Width - (Muldv (I, Haf, Haf));
    ColorRect.Right :=Width - (Muldv (I + 1, Haf, Haf));
    Canvas.FillRect(ColorRect);
  end;
end;
}
function TPicButton.OnGlyphP(X, Y: integer): boolean;
begin
  Result := PtInRect({ClientRect} BRect, Point(X, Y)) and
            (FBitmap.Canvas.Pixels[X, Y] <> FBitmap.TransparentColor);
end;

procedure TPicButton.MouseMove(Shift: TShiftState; X, Y: Integer);

begin
  FOver := (fborder = bsnormal) or (fborder = bsie) or  OnGlyphP(X, Y) or  (Fborder=BsGrad);
  Inherited MouseMove(Shift, X, Y);
end;

procedure TPicButton.mouseleave(var msg : tmessage);
var  rc : Trect;
BEGIN
  FOver := false;
  rc := getclientrect;
  if (Fborder = bsie) or (Fborder=BsGrad) then
    INVALIDATE;
END;

procedure TPicButton.mousein(var msg : tmessage);
var  rc : Trect;
BEGIN
  FOver := true;
  rc := getclientrect;
  if (Fborder = bsie) then
    frame3d(canvas, rc ,clBtnHighlight,clBtnShadow, 1);
  if Fborder=BsGrad then
  begin
      canvas.Brush.Style:=bsclear;
      //canvas.pen.Width:=2;
      canvas.Pen.Color:=rgb(255,94,32);

      canvas.RoundRect(rc.left,rc.top,rc.right,rc.bottom,FXAngle,FYAngle);
      canvas.Brush.Style:=bsclear;
      canvas.Pen.Color:=rgb(255,199,142);
      canvas.RoundRect(rc.left+1,rc.top+1,rc.right-1,rc.bottom-1,FXAngle,FYAngle);
      canvas.Brush.Style:=bsclear;
      //canvas.pen.Width:=2;
      canvas.Pen.Color:=rgb(255,229,152);
      canvas.RoundRect(rc.left+2,rc.top+2,rc.right-2,rc.bottom-2,FXAngle,FYAngle);
  end;
END;

procedure TPicButton.WMLButtonDown;
{var
   tmp:Tpoint;
   msg:Tmsg;
   }
begin
  inherited;
  //tmp:=ClientToScreen(point(0,height));
  //FPopupMenu.popup(tmp.X,tmp.y);
  Pushed := (fborder = bsnormal) or (fborder = bsie) OR FOver or  (Fborder = bsgrad);
  if pushed then
     invalidate;
end;

procedure TPicButton.WMLButtonUp;
begin
 inherited;
 if (fborder = bsnormal) or (fborder = bsie) or FOver  or  (Fborder=bsGrad) then
    Pushed := false;
 if Pushed = false then
   invalidate;
end;
{procedure TMTranbtn.Notification(AComponent: TComponent; Operation:TOperation);
begin
	if (Operation = opRemove) and (AComponent = FPopUpMenu) then
		FPopUpMenu := nil ;
end;
}
procedure Register;
begin
  RegisterComponents('Mik', [TPicButton]);
end;

end.