fcimager.pas

一套及时通讯的原码

  FPictureLoaded := False;
  if FAutoDisplay then LoadPicture;
end;

procedure TfcDBImager.UpdateData(Sender: TObject);
begin
  if Picture.Graphic is TBitmap then
     FDataLink.Field.Assign(Picture.Graphic) else
     FDataLink.Field.Clear;
end;


function TfcDBImager.GetDataSource: TDataSource;
begin
  Result := FDataLink.DataSource;
end;

procedure TfcDBImager.SetDataSource(Value: TDataSource);
begin
  if not (FDataLink.DataSourceFixed and (csLoading in ComponentState)) then
    FDataLink.DataSource := Value;
  if Value <> nil then Value.FreeNotification(Self);
end;

function TfcDBImager.GetDataField: string;
begin
  Result := FDataLink.FieldName;
end;

procedure TfcDBImager.SetDataField(const Value: string);
begin
  FDataLink.FieldName := Value;
end;

function TfcDBImager.GetReadOnly: Boolean;
begin
  Result := FDataLink.ReadOnly;
end;

procedure TfcDBImager.SetReadOnly(Value: Boolean);
begin
  FDataLink.ReadOnly := Value;
end;

function TfcDBImager.GetField: TField;
begin
  Result := FDataLink.Field;
end;

procedure TfcDBImager.CMGetDataLink(var Message: TMessage);
begin
  Message.Result := Integer(FDataLink);
end;

procedure TfcDBImager.CutToClipboard;
begin
  if Picture.Graphic <> nil then
    if FDataLink.Edit then
    begin
      CopyToClipboard;
      Picture.Graphic := nil;
    end;
end;

procedure TfcDBImager.CopyToClipboard;
begin
  if Picture.Graphic <> nil then Clipboard.Assign(Picture);
end;

procedure TfcCustomImager.PasteFromClipboard;
begin
  if Clipboard.HasFormat(CF_BITMAP) then
  begin
    Picture.Bitmap.Assign(Clipboard);
    Picture.Graphic.Transparent:=Transparent;
  end
end;

procedure TfcDBImager.PasteFromClipboard;
begin
  if Clipboard.HasFormat(CF_BITMAP) and FDataLink.Edit then
  begin
    Picture.Bitmap.Assign(Clipboard);
    Picture.Graphic.Transparent:=Transparent;
  end
end;

procedure TfcCustomImager.DoEnter;
begin
  try
    if Assigned(FOnEnter) then FOnEnter(Self);
    FFocused := True;
    Invalidate; { Draw the focus marker }
  except
  end;
end;

procedure TfcCustomImager.DoExit;
begin
  try
   if Assigned(FOnExit) then FOnExit(Self);
   FFocused := False;
   Invalidate; { Erase the focus marker }
  except
  end;
end;


procedure TfcDBImager.DoExit;
begin
    try
      FDataLink.UpdateRecord;
    except
      SetFocus;
      raise;
    end;
    Invalidate; { Erase the focus marker }
    inherited;
end;

procedure TfcCustomImager.KeyUp(var Key: Word; Shift: TShiftState);
begin
  if Assigned(FOnKeyUp) then FOnKeyUp(Self, Key, Shift);
end;

procedure TfcCustomImager.KeyDown(var Key: Word; Shift: TShiftState);
begin
  if Assigned(FOnKeyDown) then FOnKeyDown(Self, Key, Shift);
  case Key of
    VK_INSERT:
      if ssShift in Shift then PasteFromClipBoard else
        if ssCtrl in Shift then CopyToClipBoard;
    VK_DELETE:
      if ssShift in Shift then CutToClipBoard;
  end;
end;

procedure TfcCustomImager.KeyPress(var Key: Char);
begin
  if Assigned(FOnKeyPress) then FOnKeyPress(self, Key);
  case Key of
    ^X: CutToClipBoard;
    ^C: CopyToClipBoard;
    ^V: PasteFromClipBoard;
  end;
end;

procedure TfcDBImager.KeyPress(var Key: Char);
begin
  inherited KeyPress(Key);
  case Key of
    ^X: CutToClipBoard;
    ^C: CopyToClipBoard;
    ^V: PasteFromClipBoard;
    #13: LoadPicture;
    #27: FDataLink.Reset;
  end;
end;

procedure TfcCustomImager.MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer);
begin
   inherited;
   if FWinControl<>nil then FWinControl.SetFocus;
end;

Function TfcCustomImager.CreateImagerWinControl: TWinControl;
var WinControl: TWinControl;
begin
   WinControl:= TfcImagerWinControl.create(self);
   with WinControl do begin
      visible:=true;
      Left:=0;
      Top:=0;
      Height:=0;
      Width:=0;
      Parent:=self.Parent;
      TabStop:=self.TabStop;
   end;
   result:= WinControl;
end;

procedure TfcCustomImager.SetFocusable(Value: boolean);
begin
   if Value<>FFocusable then begin
      FFocusable:=Value;
      if (Value or Focusable) then begin
          if (FWinControl=nil) then
             FWinControl:= CreateImagerWinControl;
          FWinControl.TabStop:=TabStop;
      end
      else begin
         if FWinControl <> nil then begin
           FWinControl.Free;
           FWinControl:=nil;
         end;
      end
   end
end;

procedure TfcCustomImager.SetTabStop(Value: boolean);
begin
   if Value<>FTabStop then begin
      FTabStop:=Value;
      if (Value or Focusable)then begin
          if (FWinControl=nil) then
             FWinControl:= CreateImagerWinControl;
          FWinControl.TabStop:=Value;
      end
      else begin
         if FWinControl <> nil then begin
            FWinControl.Free;
            FWinControl:=nil;
         end;
      end
   end
end;

procedure TfcCustomImager.SetTabOrder(Value: integer);
begin
   if Value<>FTabOrder then begin
      FTabOrder:=Value;
      if (Focusable) then begin
          if (FWinControl=nil) then
             FWinControl:= CreateImagerWinControl;
          FWinControl.TabOrder:=Value;
      end
      else begin
         if FWinControl <> nil then begin
           FWinControl.Free;
           FWinControl:=nil;
         end;
      end
   end
end;

procedure TfcDBImager.Paint;
var Form: TCustomForm;
//    tempImager: TfcImager;
    DrawPict: TPicture;
    CenterRect: TRect;
    r: TRect;
    j:TGraphic;
    w:TMetaFile;
    ms:TMemoryStream;
    pt:TfcImagerPictureType;
    ic:TfcIcon;
    {i,}x,y,pad:integer;
    gclassname:string;
//    pal: HPalette;
begin
   if csDestroying in ComponentState then exit;

   // Suggestion to add a new property to disablebitmapoptions.  THen
   // images will always look the same even in the non-csPaintcopy State.
{   if FDisableBitmapOptions and (not Transparent) and
       not ((DrawStyle=dsTile) or (DrawStyle=DsStretch)) then
   begin
      Canvas.Brush.Color:=Color;
      Canvas.FillRect(ClientRect);
   end;}

   if ((csPaintCopy in ControlState) {or FDisableBitmapOptions}) and
      Assigned(FDataLink.Field) and FDataLink.Field.IsBlob then
   begin
//      Canvas.Brush.Color:=TEdit(parent).color;
//      Canvas.FillRect(ClientRect);

      DrawPict := TPicture.Create;
      pt:=PictureType;
      gclassname := '';
      DoCalcPictureType(pt,gclassname);
      case pt of
        fcptBitmap: begin
           try
             DrawPict.Assign(FDataLink.Field);
           except
           end;
          end;
        fcptJpg:
          begin
            if gclassname = '' then gclassname := 'TJPEGImage';
            if (GetClass(gclassname) = nil) then exit;
//          j:= TGraphic(TGraphicClass(GetClass('TJPEGImage')).create);
            // 1/16/2002 - Should use gclassname!!
            j:= TGraphicClass(GetClass(gclassname)).create;
            ms:=tmemorystream.create;
            try
              tblobfield(FDataLink.Field).savetostream(ms);
              ms.seek(sofrombeginning,0);

              with j do begin
{                pixelformat := jf24bit;
                scale := jsfullsize;
                grayscale := False;
                performance := jpbestquality;
                progressivedisplay := True;
                progressiveencoding := True;}
                LoadFromStream(ms);
              end;
              DrawPict.assign(j);
            finally
               j.free;
               ms.free;
            end;
          end;
        fcptIcon:
          begin
            ic:=tfcIcon.create;
            ms:=tmemorystream.create;
            try
              tblobfield(FDataLink.Field).savetostream(ms);
              ms.seek(sofrombeginning,0);
              ic.LoadFromStream(ms);
              DrawPict.assign(ic);
            finally
               ic.free;
               ms.free;
            end;
          end;
        fcptMetafile:
          begin
            w:=TMetaFile.create;
            ms:=tmemorystream.create;
            try
              tblobfield(FDataLink.Field).savetostream(ms);
              ms.seek(sofrombeginning,0);
              w.LoadFromStream(ms);
              DrawPict.assign(w);
            finally
               w.free;
               ms.free;
            end;
          end;
        end;


{      case pt of
      fcptBitmap: DrawPict.Graphic.Assign(FDataLink.Field);
//      if DrawPict.Graphic is TBitmap then
//         DrawPict.Bitmap.IgnorePalette := True;

      fcptjpg:
        begin
          j:=tjpegimage.create;
          ms:=tmemorystream.create;
          try
            tblobfield(FDataLink.Field).savetostream(ms);
            Picture.assign(j);
            ms.seek(sofrombeginning,0);
            with j do begin
              pixelformat := jf24bit;
              scale := jsfullsize;
              grayscale := False;
              performance := jpbestquality;
              progressivedisplay := True;
              progressiveencoding := True;
              Picture.Graphic.loadfromstream(ms);
            end;
          finally
             j.free;
             ms.free;
          end;
        end;
      fcptMetaFile:
        begin
          w:= TMetaFile.Create;
          b:=TBitmap.Create;
          ms:=TMemoryStream.Create;
          try
            TBlobField(FDataLink.Field).SaveToStream(ms);
            ms.Seek(soFromBeginning,0);
            with w do begin
              LoadFromStream(ms);
            end;
            b.Width := Width;
            b.Height:= Height;
            b.PixelFormat := pf24bit;
            B.Canvas.Draw(0,0,w);
            DrawPict.Assign(b);
          finally
            w.Free;
            ms.free;
            b.free;
          end;
        end;
      end;}
{


bs:=tblobstream.create(table1picture,bmread);
jpgphoto:=tjpeg...cre
try..
  jpgphoto.loadfromstream(blobstream);
  picture.assign(jpgphoto);
finally
  freee

var jpg:TJpegImage;
stream:TStream;
jpg:=TJpegImage.Create;
Stream:=TMemoryStream.Create;
Table1ImgField.SavetoStream(Stream);
Stream.Position:=0;
jpg.LoadFromStream(Stream);
Image1.pICTURE.gRFAPHIC:=JPG;


tbLOBfIELD* field=(TBlobField*)Table->FieldByName('overlay");
tblobstream*stream=newTBlobstream...
Tjpegimage* image = new TJpegImage
picture.assign(image);
picture.graphic.loadfromstream(stream);
delete(image);

metafile
stream=new(tblobstream(field,bmread);
image1->picture->Metafile->Loadfromstream(stream);

icon
stream=new(tblobstream(field,bmread);
image1->picture->icon->Loadfromstream(stream);


jpg.assign(tblobfield(table1.fieldbyname('picture')));
jpg.dibneeded;
picture.bitmap.assign(jpg);
jpg.free;

field.savetostream(memstream);
memstream.seek(0,0);
jpg.loadfromstream(memstream);
picture.assign(jpg)
jpg.free;
memstream.free;


}
      if DrawPict.Width=0 then exit;

      if Transparent then
         Canvas.CopyMode:= cmSrcAnd
      else
         Canvas.CopyMode:= cmSrcCopy;