fcimager.pas

一套及时通讯的原码

      r:= ClientRect;
      r.right:= Width;
      r.bottom:= Height;

      CenterRect:= r;
      CenterRect.Left:= (Width-DrawPict.Width) div 2;
      CenterRect.Top:=  (Height-DrawPict.Height) div 2;

      if (DrawPict.Graphic <> nil) and (DrawPict.Graphic.Palette <> 0) then
      begin
        PaletteChanged(True); // Realizes palette before painting
      end;

      if (not Transparent) and not ((DrawStyle=dsTile) or (DrawStyle=DsStretch)) then
      begin
        Canvas.Brush.Color:=Color;
        Canvas.FillRect(ClientRect);
      end;

      if (DrawPict.Graphic = nil) or DrawPict.Graphic.empty then exit;

      case DrawStyle of
          dsNormal: Canvas.Draw(0, 0, DrawPict.Graphic);
          dsCenter: Canvas.Draw(CenterRect.Left, CenterRect.Top-1, DrawPict.Graphic);
          dsTile, dsStretch: Canvas.StretchDraw(r, DrawPict.Graphic);
          dsProportional: begin
                  //3/14/2002 - Correct for painting in a grid when csPaintCopy State.
                  x:= Trunc(DrawPict.Graphic.Width*(Height / DrawPict.Graphic.Height));
                  y:= Trunc(DrawPict.Graphic.Height*(Width / DrawPict.Graphic.width));
                  if DrawPict.Graphic.Width > DrawPict.Graphic.Height then begin
                     if Height <= y then
                        canvas.stretchdraw(rect(0,0,x,Height),DrawPict.Graphic)
                     else
                        canvas.stretchdraw(rect(0,0,Width,y),DrawPict.Graphic)
                  end
                  else begin
                     if Width <= x then
                       canvas.stretchdraw(rect(0,0,Width,y),DrawPict.Graphic)
                     else canvas.stretchdraw(rect(0,0,x,Height),DrawPict.Graphic);
                  end;
                end;
          dsProportionalCenter:
                begin//!!!!!
                  if (Height>=Width) then
                  begin
                     x:= Trunc(DrawPict.Graphic.Width*(Height / DrawPict.Graphic.Height));
                     y:= Trunc(DrawPict.Graphic.Height*(Width / DrawPict.Graphic.width));
                     if Height <= y then
                     //DrawPict.Graphic.Height > DrawPict.Graphic.Width then
                     begin
//                       i:= Trunc(DrawPict.Graphic.Width*(Height / DrawPict.Graphic.Height));
                       pad := Trunc((Width-x) / 2);
                       canvas.stretchdraw(rect(r.Left+pad,r.Top,r.Left+x+pad,r.Top+Height),DrawPict.Graphic);
                     end
                     else begin
                       y:= Trunc(DrawPict.Graphic.Height*(Width / DrawPict.Graphic.width));
                       pad := Trunc((Height-y) / 2)-1;
                     //  if pt=fcptJpg then dec(pad);
                       canvas.stretchdraw(rect(r.Left,r.Top+pad,r.Left+Width,r.Top+y+pad),DrawPict.Graphic)
                     end;
                  end
                  else begin
                     x:= Trunc(DrawPict.Graphic.Width*(Height / DrawPict.Graphic.Height));
                     y:= Trunc(DrawPict.Graphic.Height*(Width / DrawPict.Graphic.width));
                     if (Width <= x) then
                     begin
                       pad := Trunc((Height-y) / 2);
                     //  if pt=fcptJpg then dec(pad);
                       canvas.stretchdraw(rect(r.Left,r.Top+pad,r.Left+Width,r.Top+y+pad),DrawPict.Graphic)
                     end
                     else begin
                       pad := Trunc((Width-x) / 2)-1;
  //                     if DrawPict.Graphic.Width > DrawPict.Graphic.Height then dec(pad);
                       canvas.stretchdraw(rect(r.Left+pad,r.Top,r.Left+x+pad,r.Top+Height),DrawPict.Graphic);
                     end;
                  end;
                end;

//          dsProportional,dsproportionalcenter: Canvas.StretchDraw(r, DrawPict.Graphic);
      end;
      DrawPict.Free;
      Canvas.CopyMode:= cmSrcCopy;
      exit;
//      Canvas.CopyRect(ClientRect,
//              inherited Canvas, tempRect);

      //    Canvas.Brush.Style := bsClear;
{      tempImager := TfcImager.create(self);
      tempImager.height:= height;
      tempImager.width:=width;
      tempImager.picture.assign(FDataLink.Field);
      if Transparent then
         if not tempImager.PictureEmpty then
            tempImager.Picture.Graphic.Transparent := True;
         tempImager.transparent:=True;

      SetBkMode(Canvas.Handle, windows.TRANSPARENT);
      tempImager.Perform(WM_PAINT, Canvas.Handle, 0);
      SetBkMode(Canvas.Handle, OPAQUE);
      tempImager.Free;
      exit;
}
//      if Picture.Graphic is TBitmap then
//         DrawPict.Bitmap.IgnorePalette := QuickDraw;
   end;

   if not Transparent and not ((DrawStyle=dsTile) or (DrawStyle=DsStretch)) then
   begin
      Canvas.Brush.Color:=Color;
      Canvas.FillRect(ClientRect);
   end;

   inherited;
   Form := GetParentForm(Self);
   if (Form <> nil) and
    (Form.ActiveControl = self) and
     not (csDesigning in ComponentState) and
     not (csPaintCopy in ControlState) then begin
     if not fcisinwwGrid(self) then
     begin
       Canvas.Brush.Color := clWindowFrame;
       r:= ClientRect;
       Canvas.FrameRect(r);
     end
     else begin
     end;
   end;
end;

procedure TfcDBImager.DoCalcPictureType(var PictureType:TfcImagerPictureType;var GraphicClassName:String);
begin
   inherited;
   if Assigned(FOnCalcPictureType) then
      FOnCalcPictureType(Self, PictureType,GraphicClassName);
end;


procedure TfcDBImager.SetAutoDisplay(Value: Boolean);
begin
  if FAutoDisplay <> Value then
  begin
    FAutoDisplay := Value;
    if Value then LoadPicture;
  end;
end;
                         
procedure TfcDBImager.BitmapChange(Sender: TObject);
begin
  inherited;

  if FPictureLoaded then FDataLink.Modified;
  FPictureLoaded := True;

end;

procedure TfcDBCustomImager.CMEnter(var Message: TCMEnter);
begin
  inherited;
  invalidate; { Draw the focus marker }
end;

procedure TfcDBImager.CMExit(var Message: TCMExit);
begin
  try
    FDataLink.UpdateRecord;
  except
    SetFocus;
    raise;
  end;
  inherited;
end;

procedure TfcDBCustomImager.CMExit(var Message: TCMExit);
begin
  inherited;
  invalidate; { Draw the focus marker }
end;

function TfcDBCustomImager.GetRespectPalette;
begin
  result:= FRespectPalette;
end;

function TfcDBCustomImager.GetSmoothStretching: Boolean;
begin
  result := WorkBitmap.SmoothStretching;
end;

function TfcDBCustomImager.GetTransparent: Boolean;
begin
  result:= FTransparent;
//  result := False;
//  if not PictureEmpty then result := Picture.Graphic.Transparent;
end;


function TfcDBCustomImager.GetTransparentColor: TColor;
begin
  result := WorkBitmap.TransparentColor;
end;

procedure TfcDBCustomImager.SetAutoSize(Value: Boolean);
begin
  if FAutoSize <> Value then
  begin
    FAutoSize := Value;
    UpdateAutoSize;
  end;
end;

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

procedure TfcDBCustomImager.SetPicture(Value: TPicture);
begin
  FPicture.Assign(Value);
end;

procedure TfcDBCustomImager.SetPreProcess(Value: Boolean);
begin
  if FPreProcess <> Value then
  begin
    FPreProcess := Value;
    Resized;
  end;
end;

procedure TfcDBCustomImager.SetRespectPalette(Value: Boolean);
begin
  FRespectPalette:= Value;
  WorkBitmap.RespectPalette := Value;
  if value then
     if (BitmapOptions.Color<>clNone) or (BitmapOptions.TintColor<>clNone) then
        WorkBitmap.RespectPalette:= False;

  Invalidate;
end;

procedure TfcDBCustomImager.SetSmoothStretching(Value: Boolean);
begin
  WorkBitmap.SmoothStretching := Value;
  UpdateWorkBitmap;
  Invalidate;
end;

procedure TfcDBCustomImager.SetTransparent(Value: Boolean);
begin
  FTransparent:=Value;
  if not PictureEmpty then Picture.Graphic.Transparent := Value;
  if Value then
  begin
     SetWindowLong(Parent.Handle, GWL_STYLE,
       GetWindowLong(Parent.Handle, GWL_STYLE) and not WS_CLIPCHILDREN);
  end;
  Invalidate;
end;

procedure TfcDBCustomImager.SetTransparentColor(Value: TColor);
begin
  WorkBitmap.TransparentColor := Value;
  UpdateWorkBitmap;
  Invalidate;
  ColorToString(clNone);
end;

function TfcDBCustomImager.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 TfcDBCustomImager.NotifyChanges;
var i: Integer;
begin
  for i := 0 to FChangeLinks.Count - 1 do with TfcChangeLink(FChangeLinks[i]) do
  begin
    Sender := WorkBitmap;
    Change;
  end;
end;

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

procedure TfcDBCustomImager.BitmapChange(Sender: TObject);
var r: TRect;
begin
  Resized;
  r := BoundsRect;
  //5/30/2001-PYW- Make certain parent's handle has already been allocated.
  if (Parent<>nil) and Parent.HandleAllocated then { 8/2/99 }
     InvalidateRect(Parent.Handle, @r, True);
  NotifyChanges;
end;

procedure TfcDBCustomImager.UpdateAutoSize;
begin
  if FAutoSize and not PictureEmpty and not (csLoading in ComponentState) and (Align = alNone) then
  begin
    UpdatingAutosize := True;
    if (Width <> Picture.Width) or (Height <> Picture.Height) then
      SetBounds(Left, Top, Picture.Width, Picture.Height);
    UpdatingAutosize := False;
  end;
end;

procedure TfcDBCustomImager.Loaded;
begin
  inherited;
  UpdateAutoSize;
  FBitmapOptions.Changed;
end;

procedure TfcDBCustomImager.Paint;
begin
  inherited;
  if csDestroying in ComponentState then exit;

  if FWorkBitmap.Empty and not PictureEmpty then
  begin
    UpdateWorkBitmap;
    Exit;
  end;

  if (csDesigning in ComponentState) and FWorkBitmap.Empty then with Canvas do
  begin
    Pen.Style := psDash;
    Pen.Color := clBlack;
    Brush.Color := clWhite;
    Rectangle(0, 0, Width, Height);
    Exit;
  end;
  if FWorkBitmap.Empty then Exit;

  try
    with GetDrawRect do
      if PreProcess then
        case DrawStyle of
          dsNormal: Canvas.Draw(Left, Top, FWorkBitmap);
          dsCenter: Canvas.Draw(Left, Top, FWorkBitmap);
          dsTile: FWorkBitmap.TileDraw(Canvas, Rect(Left, Top, Right, Bottom));
          dsStretch: Canvas.StretchDraw(Rect(Left, Top, Right, Bottom), FWorkBitmap);
          dsProportional,dsProportionalCenter: Canvas.StretchDraw(Rect(Left, Top, Right, Bottom), FWorkBitmap);
        end
      else Canvas.Draw(Left, Top, FWorkBitmap);
  finally
{    if Transparent then fcTransparentDraw(Canvas, Rect(0, 0, Width, Height), DrawBitmap, DrawBitmap.Canvas.Pixels[0, 0])
    else Canvas.Draw(0, 0, DrawBitmap);}
  end;
end;

constructor TfcDBCustomImager.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ParentColor := False;
  Color:= clWindow;
  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;
  FChangeLinks := TList.Create;
  Width := 100;
  Height := 100;
end;

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

function TfcDBCustomImager.PictureEmpty: Boolean;
begin
  result := (FPicture=Nil) or (FPicture.Graphic = nil) or (FPicture.Graphic.Empty);
end;

procedure TfcDBCustomImager.Invalidate;
var r: TRect;
begin
  if InSetBounds then exit;
  r := BoundsRect;
  if not HandleAllocated then exit;
  InvalidateRect(Handle, nil, False);
  if Transparent then
    if Parent <> nil then InvalidateRect(Parent.Handle, @r, True);
end;

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

end;

procedure TfcDBCustomImager.RegisterChanges(ChangeLink: TfcChangeLink);
begin
  FChangeLinks.Add(ChangeLink);
end;

procedure TfcDBCustomImager.UnRegisterChanges(ChangeLink: TfcChangeLink);
begin
  FChangeLinks.Remove(ChangeLink);
end;

procedure TfcDBCustomImager.SetBounds(ALeft, ATop, AWidth, AHeight: Int