fcimager.pas

一套及时通讯的原码

    property ParentCtl3D;
    property ParentColor default False;
    property PictureType: TfcImagerPictureType read FPictureType write SetPictureType default fcptBitmap;
    property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;

    property Align;
    property AutoSize;
    property BitmapOptions;
    property DrawStyle;
//    property Picture;
    property PreProcess;
    property RespectPalette;
    property SmoothStretching;
    property Transparent;
    property TransparentColor;
    property Visible;

    property Anchors;
    property Constraints;
    property OnEndDock;
    property OnStartDock;
    property OnClick;
    property OnCalcPictureType: TfcCalcPictureTypeEvent read FOnCalcPictureType write FOnCalcPictureType;

    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDrag;
    property TabOrder;
    property TabStop;
    property OnKeyPress;
    property OnKeyDown;
    property OnKeyUp;
    property OnEnter;
    property OnExit;
  end;

implementation

uses clipbrd;

constructor TfcRotate.Create(BitmapOptions: TfcBitmapOptions);
begin
  inherited Create;
  FCenterX := -1;
  FCenterY := -1;
  FBitmapOptions := BitmapOptions;
end;

procedure TfcRotate.SetCenterX(Value: Integer);
begin
  if FCenterX <> Value then
  begin
    FCenterX := Value;
    FBitmapOptions.Changed;
  end;
end;

procedure TfcRotate.SetCenterY(Value: Integer);
begin
  if FCenterY <> Value then
  begin
    FCenterY := Value;
    FBitmapOptions.Changed;
  end;
end;

procedure TfcRotate.SetAngle(Value: Integer);
begin
  if FAngle <> Value then
  begin
    FAngle := Value;
    FBitmapOptions.Changed;
  end;
end;

constructor TfcAlphaBlend.Create(BitmapOptions: TfcBitmapOptions);
begin
  inherited Create;
  FBitmapOptions := BitmapOptions;
  FBitmap := TfcBitmap.Create;
//  FBitmap.OnChange := BitmapChanged;
end;

destructor TfcAlphaBlend.Destroy;
begin
  FBitmap.Free;
  inherited;
end;

procedure TfcAlphaBlend.BitmapChanged(Sender: TObject);
begin
  if FChanging then Exit;
  FChanging := True;
  FBitmapOptions.Changed;
  FChanging := False;
end;

function TfcAlphaBlend.GetTransparent: Boolean;
begin
  result := Bitmap.Transparent;
end;

procedure TfcAlphaBlend.SetTransparent(Value: Boolean);
begin
  Bitmap.Transparent := Value;
end;

procedure TfcAlphaBlend.SetAmount(Value: Byte);
begin
  if FAmount <> Value then
  begin
    FAmount := Value;
    FBitmapOptions.Changed;
  end;
end;

procedure TfcAlphaBlend.SetBitmap(Value: TfcBitmap);
begin
  FBitmap.Assign(Value);
end;

constructor TfcWave.Create(BitmapOptions: TfcBitmapOptions);
begin
  inherited Create;
  FBitmapOptions := BitmapOptions;
end;

procedure TfcWave.SetXDiv(Value: Integer);
begin
  if FXDiv <> Value then
  begin
    FXDiv := Value;
    FBitmapOptions.Changed;
  end;
end;

procedure TfcWave.SetYDiv(Value: Integer);
begin
  if FYDiv <> Value then
  begin
    FYDiv := Value;
    FBitmapOptions.Changed;
  end;
end;

procedure TfcWave.SetRatio(Value: Integer);
begin
  if FRatio <> Value then
  begin
    FRatio := Value;
    FBitmapOptions.Changed;
  end;
end;

procedure TfcWave.SetWrap(Value: Boolean);
begin
  if FWrap <> Value then
  begin
    FWrap := Value;
    FBitmapOptions.Changed;
  end;
end;

constructor TfcBitmapOptions.Create(AComponent: TComponent);
begin
  inherited Create;
  FComponent := AComponent;

  FAlphaBlend := TfcAlphaBlend.Create(self);
  FRotation := TfcRotate.Create(self);
  FColor := clNone;
  FTintColor := clNone;
  FSaturation := -1;
  FWave := TfcWave.Create(self);
end;

destructor TfcBitmapOptions.Destroy;
begin
  FAlphaBlend.Free;                    
  FRotation.Free;
  FWave.Free;
  inherited;
end;

procedure TfcBitmapOptions.Changed;
var TmpBitmap: TfcBitmap;
begin
  if (csLoading in FComponent.ComponentState) or DestBitmap.Empty or ((OrigPicture.Graphic = nil) or OrigPicture.Graphic.Empty) or (FUpdateLock > 0) then Exit;
  if (DestBitmap.Width = OrigPicture.Width) and (DestBitmap.Height = OrigPicture.Height) then
    DestBitmap.Assign(OrigPicture.Graphic)
  else begin
    if Tile then fcTileDraw(OrigPicture.Graphic, DestBitmap.Canvas, Rect(0, 0, DestBitmap.Width, DestBitmap.Height))
    else begin
      TmpBitmap := TfcBitmap.Create;
      TmpBitmap.Assign(OrigPicture.Graphic);
      if FComponent is TfcCustomImager then
         TmpBitmap.SmoothStretching := TfcCustomImager(FComponent).SmoothStretching
      else if FComponent is TfcDBCustomImager then
         TmpBitmap.SmoothStretching := TfcDBCustomImager(FComponent).SmoothStretching;
      try
        DestBitmap.Canvas.StretchDraw(Rect(0, 0, DestBitmap.Width, DestBitmap.Height), TmpBitmap);
      finally
        TmpBitmap.Free;
      end;
    end;
  end;

  if FGrayScale then DestBitmap.GrayScale;
  if FLightness <> 0 then DestBitmap.Brightness(FLightness);
  if (FAlphaBlend.Amount <> 0) and not FAlphaBlend.Bitmap.Empty then
    DestBitmap.AlphaBlend(FAlphaBlend.Bitmap, FAlphaBlend.Amount, True);
  if FColor <> clNone then with fcGetColor(ColorToRGB(FColor)) do
    DestBitmap.Colorize(r, g, b);
  if FTintColor <> clNone then with fcGetColor(ColorToRGB(FTintColor)) do
    DestBitmap.ColorTint(r div 2, g div 2, b div 2);
  if FSponge <> 0 then DestBitmap.Sponge(FSponge);
  if FSaturation <> -1 then DestBitmap.Saturation(FSaturation);
  if FGaussianBlur <> 0 then DestBitmap.GaussianBlur(FGaussianBlur);
  if FEmbossed then DestBitmap.Emboss;
  if FInverted then DestBitmap.Invert;
  if FContrast <> 0 then DestBitmap.Contrast(FContrast);
  if FSharpen <> 0 then DestBitmap.Sharpen(FSharpen);
  if FHorizontallyFlipped then DestBitmap.Flip(True);
  if FVerticallyFlipped then DestBitmap.Flip(False);
  with FWave do if (Ratio <> 0) and (XDiv <> 0) and (YDiv <> 0) then
    DestBitmap.Wave(XDiv, YDiv, Ratio, Wrap);
  if FRotation.Angle <> 0 then with Rotation do
    DestBitmap.Rotate(Point(CenterX, CenterY), Angle);

  if Assigned(FOnChange) then FOnChange(self);
end;

procedure TfcBitmapOptions.BeginUpdate;
begin
  inc(FUpdateLock);
end;

procedure TfcBitmapOptions.EndUpdate;
begin
  if FUpdateLock > 0 then dec(FUpdateLock);
  Changed;
end;

procedure TfcBitmapOptions.SetColor(Value: TColor);
begin
  if FColor <> Value then
  begin
    FColor := Value;
    Changed;
  end;
end;

procedure TfcBitmapOptions.SetTintColor(Value: TColor);
begin
  if FTintColor <> Value then
  begin
    FTintColor := Value;
    Changed;
  end;
end;

procedure TfcBitmapOptions.SetIntegralProperty(Index: Integer; Value: Integer);
  procedure DoCheck(StorageVar: PInteger);
  begin
    if StorageVar^ <> Value then
    begin
      StorageVar^ := Value;
      Changed;
    end;
  end;
begin
  case Index of
    0: DoCheck(@FLightness);
    1: DoCheck(@FSaturation);
    2: DoCheck(@FSponge);
    3: DoCheck(@FGaussianBlur);
    4: DoCheck(@FContrast);
    5: DoCheck(@FSharpen);
  end;
end;

type PBoolean = ^Boolean;

type TfcIcon = class(TIcon)
protected
    procedure Draw(ACanvas: TCanvas; const Rect: TRect); override;
end;

type TCheatCanvas=class(TCanvas);

procedure TfcIcon.Draw(ACanvas: TCanvas; const Rect: TRect);
begin
  with Rect.TopLeft do
  begin
    TCheatCanvas(ACanvas).RequiredState([csHandleValid]);
    DrawIconEx(ACanvas.Handle, X, Y, Handle, Rect.Right-Rect.Left, Rect.Bottom-Rect.Top, 0, 0, DI_NORMAL);
  end;
end;

procedure TfcBitmapOptions.SetBooleanProperty(Index: Integer; Value: Boolean);
  procedure DoCheck(StorageVar: PBoolean);
  begin
    if StorageVar^ <> Value then
    begin
      StorageVar^ := Value;
      Changed;
    end;
  end;
begin
  case Index of
    0: DoCheck(@FEmbossed);
    1: DoCheck(@FInverted);
    2: DoCheck(@FGrayScale);
    3: DoCheck(@FHorizontallyFlipped);
    4: DoCheck(@FVerticallyFlipped);
  end;
end;

constructor TfcCustomImager.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FEraseBackground:= True;
  FPicture := TPicture.Create;
  FPicture.OnChange := BitmapChange;
  FWorkBitmap := TfcBitmap.Create;
  FRespectPalette:= True;
  FWorkBitmap.RespectPalette := True;
  FWorkBitmap.UseHalftonePalette:= True;
  FBitmapOptions := TfcBitmapOptions.Create(self);
  FBitmapOptions.OnChange := BitmapOptionsChange;
  FBitmapOptions.DestBitmap := FWorkBitmap;
  FBitmapOptions.OrigPicture := FPicture;
  ControlStyle := ControlStyle + [csOpaque];
  FPreProcess := True;
  FShowFocusRect:=False;
  FFocusable := False;
  FTabStop := False;
  FChangeLinks := TList.Create;
  Width := 100;
  Height := 100;
end;

destructor TfcCustomImager.Destroy;
begin
  FPicture.Free;
  FPicture:= nil;
  FBitmapOptions.Free;
  FWorkBitmap.Free;
  FChangeLinks.Free;
  inherited Destroy;
end;

function TfcCustomImager.GetDrawRect: TRect;
begin
  case DrawStyle of
    dsNormal: result := Rect(0, 0, Picture.Width, Picture.Height);
    dsCenter: with Point(Width div 2 - FWorkBitmap.Width div 2,
        Height div 2 - FWorkBitmap.Height div 2) do
      result := Rect(x, y, Width - x, Height - y);
    dsTile, dsStretch: result := Rect(0, 0, Width, Height);
    dsProportional: result := fcProportionalRect(Rect(0, 0, Width, Height),
                              FWorkBitmap.Width, FWorkBitmap.Height);
    dsProportionalCenter: result := fcProportionalCenterRect(Rect(0, 0, Width, Height),
                                    FWorkBitmap.Width, FWorkBitmap.Height);
  end
end;

procedure TfcCustomImager.SetDrawStyle(Value: TfcImagerDrawStyle);
begin
  if FDrawStyle <> Value then
  begin
    FDrawStyle := Value;
    BitmapOptions.Tile := FDrawStyle = dsTile;
    Resized;
    Invalidate;
  end;
end;

procedure TfcCustomImager.SetEraseBackground(Value: Boolean);
var r: TRect;
begin
  if FEraseBackground <> Value then
  begin
    FEraseBackground := Value;
    if Parent <> nil then begin
       r:= BoundsRect;
       InvalidateRect(Parent.Handle, @r, True);
    end
  end;
end;

procedure TfcCustomImager.SetParent(Value: TWinControl);
begin
  inherited;
end;

procedure TfcCustomImager.BitmapOptionsChange(Sender: TObject);
var r: TRect;
begin
  if Parent <> nil then
  begin
    r := BoundsRect;
    InvalidateRect(Parent.Handle, @r, Transparent);
  end;
  NotifyChanges;
end;

procedure TfcCustomImager.NotifyChanges;
var i: Integer;
begin
  for i := 0 to FChangeLinks.Count - 1 do with TfcChangeLink(FChangeLinks[i]) do
  begin
    Sender := WorkBitmap;
    Change;
  end;
end;

function TfcCustomImager.GetColorAtPoint(X,Y:Integer):TColor;
begin
  result := clNone;
  if (Canvas <> nil) then result := Canvas.Pixels[X, Y];
end;

procedure TfcCustomImager.BitmapChange(Sender: TObject);
var r: TRect;
begin
  Resized;
  r := BoundsRect;
  if Parent<>nil then { 8/2/99 }
     InvalidateRect(Parent.Handle, @r, True);
  NotifyChanges;
end;

procedure TfcCustomImager.Resized;
begin
  if csLoading in ComponentState then Exit;
  if not PreProcess and not (DrawStyle in [dsNormal, dsCenter]) then
    FWorkBitmap.SetSize(Width, Height)
  else begin
     if BitmapOptions.Rotation.Angle <> 0 then { 10/5/99 }