fcimgbtn.pas

一套及时通讯的原码

        ResultPt.x := CurrentCol;
        ResultPt.y := CurrentRow;
        if not NotColor then ResultPt := CheckPoint(Point(ResultPt.x - 1, ResultPt.y - 1));
        Break;
      end;
      if SearchForward then inc(CurrentCol) else dec(CurrentCol);
      if SearchForward then inc(CurrentRow) else dec(CurrentRow);
    end;
  end;
  procedure DrawHighlights(ABtnBlack, ABtnShadow, ABtn3dLight, ABtnHighlight: TfcColor);
  var AEndPt, AStartPt: TPoint;
  begin
    AEndPt := EndPt;
    AStartPt := StartPt;
    if (boFocusable in Options) and (Focused) then
      AStartPt := Point(AStartPt.x + 1, AStartPt.y + 1);

    with Point(AEndPt.x - 1, AEndPt.y - 1) do
      if PointValid(x, y) then DstPixels[y, x] := ABtnShadow;
    with Point(AStartPt.x + 1, AStartPt.y + 1) do
      if PointValid(x, y) then DstPixels[y, x] := ABtn3dLight;
    with Point(AEndPt.x, AEndPt.y) do
      if PointValid(x, y) then DstPixels[y, x] := ABtnBlack;
    with Point(AStartPt.x, AStartPt.y) do
      if PointValid(x, y) then DstPixels[y, x] := ABtnHighlight;

    if (boFocusable in Options) and (Focused) and Down then
      with Point(AStartPt.x - 1, AStartPt.y - 1) do
        if PointValid(x, y) then DstPixels[y, x] := fcGetColor(clBlack);
  end;
begin
  if SrcBitmap.Empty or (SrcBitmap.Width <> DstBitmap.Width) or (SrcBitmap.Height <> DstBitmap.Height) then
    Exit;

  // Must convert to BGR values because apparantly that's what PixBuf is...
  ABtnHighlight := fcGetColor(ColorToRGB(ShadeColors.BtnHighlight));
  ABtn3dLight := fcGetColor(ColorToRGB(ShadeColors.Btn3dLight));
  ABtnShadow := fcGetColor(ColorToRGB(ShadeColors.BtnShadow));
  ABtnBlack := fcGetColor(ColorToRGB(ShadeColors.BtnBlack));

  BitmapSize.cx := SrcBitmap.Width;
  BitmapSize.cy := SrcBitmap.Height;

  WorkingBm := TfcBitmap.Create;
  WorkingBm.Assign(SrcBitmap);
//  DstBm := nil;
{  if DstBitmap = SrcBitmap then WorkingPixels := WorkingBm.Pixels
  else begin
    DstBm := TfcBitmap.Create;
    DstBm.Assign(DstBitmap);
    WorkingPixels := DstBm.Pixels;
  end;}
  SrcPixels := WorkingBm.Pixels;
  DstPixels := DstBitmap.Pixels;

  if TransColor = -1 then TransColor := fcGetStdColor(WorkingBm.Pixels[0, 0]);

  try
    // Work Diagonally from top right of image to Top left of image
    Col := BitmapSize.cx - 1;
    Row := 0;
    while Row < WorkingBm.Height do
    begin
      // Find the first non transparent pixel
      EndPt := Point(Col - 1, Row - 1);

      repeat
        StartPt := Point(-1, -1);

        GetFirstPixelColor(EndPt.x + 1, EndPt.y + 1, StartPt, TransColor, True, True);
        if (StartPt.x <> -1) and (StartPt.y <> -1) then
        begin
          OldEndPt := EndPt;
          EndPt := CheckPoint(Point(Col + fcMin(BitmapSize.cx - 1 - Col, BitmapSize.cy - 1 - Row),
            Row + fcMin(BitmapSize.cx - 1 - Col, BitmapSize.cy - 1 - Row)));
          GetFirstPixelColor(StartPt.x + 1, StartPt.y + 1, EndPt, TransColor, False, True);

          if Focused or Default then
          begin
            StartPt := Point(StartPt.x + 1, StartPt.y + 1);
            EndPt := Point(EndPt.x - 1, EndPt.y - 1);
          end;

          if not Down then DrawHighlights(ABtnBlack, ABtnShadow, ABtn3dLight, ABtnHighlight)
          else DrawHighlights(ABtnHighlight, ABtn3dLight, ABtnShadow, ABtnBlack);

          if Focused or Default then
          begin
            StartPt := Point(StartPt.x - 1, StartPt.y - 1);
            EndPt := Point(EndPt.x + 1, EndPt.y + 1);
            DstPixels[StartPt.y, StartPt.x] := ABtnBlack;
            DstPixels[EndPt.y, EndPt.x] := ABtnBlack;
          end;
        end;
      until (StartPt.x = -1) and (StartPt.y = -1);
      if Col > 0 then dec(Col) else inc(Row);
    end;
{
    if SrcBitmap = DstBitmap then
      DstBitmap.Canvas.Draw(0, 0, WorkingBm)
    else begin
      DstBitmap.Canvas.Draw(0, 0, DstBm);
      DstBm.Free;
    end;}
  finally
    WorkingBm.Free;
  end;
end;

function TfcCustomImageBtn.ColorAtPoint(APoint: TPoint): TColor;
var Bitmap: TfcBitmap;
begin
  Bitmap := TfcBitmap.Create;
  try
    GetDrawBitmap(Bitmap, False, ShadeStyle, Down);
    result := Bitmap.Canvas.Pixels[APoint.x, APoint.y];
  finally
    Bitmap.Free;
  end;
end;

procedure TfcCustomImageBtn.GetDrawBitmap(DrawBitmap: TfcBitmap; ForRegion: Boolean;
  ShadeStyle: TfcShadeStyle; Down: Boolean);
var TempImage: TfcBitmap;
    Offset: TPoint;
begin
  DrawBitmap.SetSize(Width, Height);
  if RespectPalette then
  begin
    CopyMemory(@DrawBitmap.Colors, @ObtainImage(False).Colors, SizeOf(ObtainImage(False).Colors));
    DrawBitmap.Patch[0]:= ObtainImage(False).Patch[0]; { 12/7/99 - Transfer patch variables to support bitmap palette}
    DrawBitmap.Patch[1]:= ObtainImage(False).Patch[1];
    DrawBitmap.RespectPalette := True;
  end;

  //3/16/99 - PYW - Raises canvas draw error when anchors cause width or height to be <=0
  with DrawBitmap do if (Width <=0) or (Height<=0) then exit;

  if ObtainImage(False).Empty then with DrawBitmap do
  begin
    Canvas.Brush.Color := clBtnFace;
    Canvas.Pen.Style := psDashDot;
    Canvas.Pen.Color := clBlack;
    Canvas.Rectangle(0, 0, Width, Height);
    Exit;
  end;

  Offset := Point(0, 0);                                       // Offset used if drawing shadows, etc.
  TempImage := TfcBitmap.Create;                                 // Temp image stores a copy of either Image or ImageDown
  TempImage.RespectPalette := RespectPalette;

  if not Down or ObtainImage(True).Empty then
    GetSizedImage(ObtainImage(False), TempImage, ShadeStyle, ForRegion, Down)                            // If the button is not down or there is no down image
  else
    GetSizedImage(ObtainImage(True), TempImage, ShadeStyle, ForRegion, Down);                    // defined then use the up image, otherwise use the down image.

  try
    if Down and ObtainImage(True).Empty then Offset := Point(Offsets.ImageDownX, Offsets.ImageDownY);  // Offset for Upper-left shadow
    if (ShadeStyle = fbsHighlight) or ((ShadeStyle = fbsFlat) and MouseInControl(-1, -1, False)) then
    begin
      DrawBitmap.Canvas.Draw(Offset.x, Offset.y, TempImage);
      Draw3dLines(TempImage, DrawBitmap, GetTransparentColor(Down), Down);
      Offset := Point(-1, -1);
    end else begin
       { 12/7/99 - The next 2 lines should not be needed anymore }
      DrawBitmap.Canvas.Brush.Color := ShadeColors.Shadow;
      DrawBitmap.Canvas.Pen.Color := ShadeColors.Shadow;
      DrawBitmap.Canvas.Rectangle(0, 0, Width, Height); // 1/20/2000 - Don't use TRect for Delphi 5 compatibility
//      DrawBitmap.Canvas.Rectangle(Rect(0, 0, Width, Height));   // Fill in with shadow color
    end;

    if (Offset.x <> -1) and (Offset.y <> -1) then
    begin
      if TransparentColor <> clNullColor then
      begin
        { 12/7/99 - Change transparent pixels to shadow color }
        if Down and (DitherStyle=dsBlendDither) then begin
          TempImage.Transparent := True;
          TempImage.TransparentColor := GetTransparentColor(Down);
        end
        else
          TempImage.ChangeColor(fcGetColor(GetTransparentColor(down)), fcGetcolor(ShadeColors.Shadow));
//        TempImage.Transparent := True;
//        TempImage.TransparentColor := GetTransparentColor(Down);
      end;
      DrawBitmap.Canvas.Draw(Offset.x, Offset.y, TempImage)
    end;
  finally
    TempImage.Free;                                            // Clean up temp bitmaps
  end;
end;

procedure TfcCustomImageBtn.SplitImage;
var Bitmap, Bitmap2: TfcBitmap;
    ARgn: HRGN;
begin
  if not ObtainImage(False).Empty then
  begin
    Bitmap := TfcBitmap.Create;
    Bitmap2 := TfcBitmap.Create;
    GetDrawBitmap(Bitmap, False, fbsHighlight, False);
    GetDrawBitmap(Bitmap2, False, fbsHighlight, True);
    ARgn := CreateRegion(True, Down);
    fcClipBitmapToRegion(Bitmap2, ARgn);
    DeleteObject(ARgn);
    ObtainImage(False).Assign(Bitmap);
    ImageDown.Assign(Bitmap2);
    Bitmap.Free;
    Bitmap2.Free;
    RecreateWnd;
  end;
end;

procedure TfcCustomImageBtn.SizeToDefault;
var Rect: TRect;
begin
  if not ObtainImage(False).Empty then
  begin
    Width := ObtainImage(False).Width;
    Height := ObtainImage(False).Height;
    Rect := BoundsRect;
    if Parent <> nil then InvalidateRect(Parent.Handle, @Rect, True);
  end;
end;

procedure TfcCustomImageBtn.AssignTo(Dest: TPersistent);
begin
  if Dest is TfcCustomImageBtn then
    with Dest as TfcCustomImageBtn do
  begin
    DitherColor := self.DitherColor;
    DitherStyle := self.DitherStyle;
{    Image := self.Image;
    ImageDown := self.ImageDown;  DONT CHANGE THIS!!!}
    ExtImage := self;
    ExtImageDown := self;
    Offsets.Assign(self.Offsets);
    RespectPalette := self.RespectPalette;
    TransparentColor := self.TransparentColor;
  end;
  inherited;
end;

procedure TfcCustomImageBtn.CreateWnd;
begin
  if Image.Sleeping then Image.Wake;
  inherited;
  ApplyRegion;
end;

procedure TfcCustomImageBtn.DestroyWnd;
begin
  inherited;
  Image.Sleep;
end;

procedure TfcCustomImageBtn.GetSizedImage(SourceBitmap: TfcBitmap; DestBitmap: TfcBitmap;
  ShadeStyle: TfcShadeStyle; ForRegion,DownFlag: Boolean);
var s: TSize;
    Rgn: HRGN;
    BlendColor: TColor;
begin

  Rgn := 0;
  s := fcSize(Width, Height);
    //3/16/99 - PYW - Raises canvas draw error when anchors cause width or height to be <=0
  if (Width <=0) or (Height<=0) then exit;

  if ShadeStyle = fbsRaised then s := fcSize(Width - 2, Height - 2);
  DestBitmap.SetSize(s.cx, s.cy);

  if not ForRegion and ((Color <> clNone) or
     ((GroupIndex > 0) and DownFlag and (DitherColor <> clNone) and ObtainImage(True).Empty)) then
    Rgn := CreateRegion(True, DownFlag);

  DestBitmap.Canvas.StretchDraw(Rect(0, 0, s.cx, s.cy), SourceBitmap);

  if not ForRegion and (Color <> clNone) then
  begin
    SelectClipRgn(DestBitmap.Canvas.Handle, Rgn);
    DestBitmap.TransparentColor := GetTransparentColor(DownFlag);
    with fcBitmap.fcGetColor(Color) do DestBitmap.Colorize(r, g, b);
  end;

  if (GroupIndex > 0) and DownFlag and (DitherColor <> clNone) and not ForRegion and ObtainImage(True).Empty then
  begin
    if ShadeStyle = fbsRaised then OffsetRgn(Rgn, -2, -2);

    SelectClipRgn(DestBitmap.Canvas.Handle, Rgn);
    if DitherStyle in [dsDither, dsBlendDither] then
    begin
      if DitherStyle = dsBlendDither then BlendColor := clNone else BlendColor := clSilver;
      fcDither(DestBitmap.Canvas, Rect(0, 0, Width, Height), BlendColor, DitherColor);
    end else begin
      DestBitmap.Canvas.Brush.Color := DitherColor;
      DestBitmap.Canvas.FillRect(Rect(0, 0, Width, Height));
    end;
  end;
  if Rgn <> 0 then
  begin
    SelectClipRgn(DestBitmap.Canvas.Handle, 0);
    DeleteObject(Rgn);
  end;
end;

procedure TfcCustomImageBtn.ImageChanged(Sender: TObject);
var ARgnData: PfcRegionData;
    r: TRect;
begin
  //3/27/2002 - This can get called during destroy in which time the RegionData is invalid so exit.
  if csDestroying in componentstate then exit;
  ARgnData := nil;
  if Sender = ObtainImage(False) then ARgnData := @FRegionData
  else if Sender = ObtainImage(True) then ARgnData := @FDownRegionData;
  if ARgnData <> nil then ClearRegion(ARgnData);

  (Sender as TfcBitmap).IgnoreChange := True;
  ApplyRegion;
  (Sender as TfcBitmap).IgnoreChange := False;

  r := BoundsRect;
  if Parent <> nil then InvalidateRect(Parent.Handle, @r, True);
  Invalidate;
end;

procedure TfcCustomImageBtn.ExtImageDestroying(Sender: TObject);
begin
  if Sender = FExtImage then FExtImage := nil;
end;

procedure TfcCustomImageBtn.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited;
  if (Operation = opRemove) then
  begin
    if (AComponent = FExtImage) then FExtImage := nil
    else if (AComponent = FExtImageDown) then FExtImageDown := nil;
  end;
end;

function TfcCustomImageBtn.GetOffsets: TfcImgDownOffsets;
begin
  result := TfcImgDownOffsets(inherited Offsets);
end;

function TfcCustomImageBtn.GetParentClipping: Boolean;
begin
  result := False;
  if Parent <> nil then
    result := GetWindowLong(Parent.Handle, GWL_STYLE) and WS_CLIPCHILDREN = WS_CLIPCHILDREN;
end;

function TfcCustomImageBtn.GetRespectPalette: Boolean;
begin
  result := ObtainImage(False).RespectPalette;
end;

procedure TfcCustomImageBtn.SetOffsets(Value: TfcImgDownOffsets);
begin
  inherited Offsets := Value;
end;

procedure TfcCustomImageBtn.SetParentClipping(Value: Boolean);
begin
  // 9/20/01
  if (Parent <> nil) and not (csDesigning in ComponentState) then
  begin
//    if Value then
//      SetWindowLong(Parent.Handle, GWL_STYLE,
//       GetWindowLong(Parent.Handle, GWL_STYLE) or WS_CLIPCHILDREN)
//    else
      // 6/25/01 - Only disable clipping
      SetWindowLong(Parent.Handle, GWL_STYLE,
        GetWindowLong(Parent.Handle, GWL_STYLE) and not WS_CLIPCHILDREN);
  end;
end;

procedure TfcCustomImageBtn.SetRespectPalette(Value: Boolean);
begin
  ObtainImage(False).RespectPalette := Value;
  ObtainImage(True).RespectPalette := Value;
  Invalidate;
end;

procedure TfcCustomImageBtn.SetTransparentColor(Value: TColor);
var Rect: TRect;
begin
  if FTransparentColor <> Value then
  begin
    FTransparentColor := Value;
    RecreateWnd;
    Rect := BoundsRect;
    if Parent <> nil then InvalidateRect(Parent.Handle, @Rect, True);
  end;
end;

function TfcCustomImageBtn.UseRegions: boolean;
begin
   result:= (FTransparentColor<>clNullColor)
end;

procedure TfcCustomImageBtn.WndProc(var Message: TMessage);
begin
  inherited;
end;

{$r+}

end.