fcimager.tst

一套及时通讯的原码

    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: 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;

(*procedure TfcCustomImager.ParentMessages(var Message: TMessage; var ProcessMessage: Boolean);
var s: TfcCustomImager;
begin
  if csDestroying in ComponentState then exit;

  if not PictureEmpty and ((not EraseBackground) or InSetBounds) and
{     not (csDesigning in ComponentState) and}  { 4/27/99 - Comment out - RSW }
     (Message.Msg = WM_ERASEBKGND) then//and not (DrawStyle in [dsNormal, dsProportional]) {and (Align = alClient) }then { 3/19/99 - Comment out alClient to prevent flicker of form}
  begin
    with TWMEraseBkGnd(Message) do
    begin
      Result := 1;
      ProcessMessage := False;
    end;
  end
end;
*)
procedure TfcCustomImager.Loaded;
begin
  inherited;
  UpdateAutoSize;
  FBitmapOptions.Changed;
end;

procedure TfcCustomImager.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
end;

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

procedure TfcCustomImager.CopyToClipboard;
var tempBitmap: TBitmap;
begin
   tempBitmap:= TBitmap.create;
   WorkBitmap.SaveToBitmap(tempBitmap);
   Clipboard.Assign(tempBitmap);
   tempBitmap.Free;
end;

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

type
 TfcImagerWinControl = class(TWinControl)
 private
    Imager: TfcDBImager;
 protected
    procedure KeyUp(var Key: Word; Shift: TShiftState); override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyPress(var Key: Char); override;
 public
    constructor Create(AOwner: TComponent); override;
    procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
    procedure CMExit(var Message: TCMExit); message CM_EXIT;
 end;

constructor TfcImagerWinControl.Create(AOwner: TComponent);
begin
   inherited;
   ControlStyle := ControlStyle + [csReplicatable];
   Imager:= AOwner as TfcDBImager;
end;

procedure TfcImagerWinControl.CMEnter(var Message: TCMEnter);
begin
  Imager.DoEnter;
end;

procedure TfcImagerWinControl.CMExit(var Message: TCMExit);
begin
  Imager.DoExit;
end;

procedure TfcImagerWinControl.KeyDown(var Key: Word; Shift: TShiftState);
begin
   inherited KeyDown(Key, Shift);
   Imager.KeyDown(Key, Shift);
end;

procedure TfcImagerWinControl.KeyUp(var Key: Word; Shift: TShiftState);
begin
   inherited KeyUp(Key, Shift);
   Imager.KeyUp(Key, Shift);
end;

procedure TfcImagerWinControl.KeyPress(var Key: Char);
begin
   inherited KeyPress(Key);
   Imager.KeyPress(Key);
end;

constructor TfcDBImager.Create(AOwner: TComponent);
begin
   inherited;
   ControlStyle := ControlStyle + [csReplicatable];

   FAutoDisplay:=True;
   FDataLink := TFieldDataLink.Create;
   FDataLink.Control := Self;
   FDataLink.OnDataChange := DataChange;
   FDataLink.OnUpdateData := UpdateData;
end;

destructor TfcDBImager.Destroy;
begin
   FDataLink.Free;
   FDataLink:=nil;
   inherited Destroy;
end;

procedure TfcDBImager.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (FDataLink <> nil) and
    (AComponent = DataSource) then DataSource := nil;
end;

procedure TfcDBImager.LoadPicture;
begin
  if not FPictureLoaded and (not Assigned(FDataLink.Field) or
    FDataLink.Field.IsBlob) then
  begin
    Picture.Assign(FDataLink.Field);
    Picture.Graphic.Transparent:=Transparent;
  end;
end;

procedure TfcDBImager.DataChange(Sender: TObject);
begin
  Picture.Graphic := nil;
  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
  Invalidate; { Draw the focus marker }
end;

procedure TfcCustomImager.DoExit;
begin
   Invalidate; { Erase the focus marker }
end;

procedure TfcDBImager.DoExit;
begin
    try
      FDataLink.UpdateRecord;
    except
      FWinControl.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
    #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
         FWinControl.Free;
         FWinControl:=nil;
      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
         FWinControl.Free;
         FWinControl:=nil;
      end
   end
end;

procedure TfcDBImager.Paint;
var Form: TCustomForm;
    tempImager: TfcImager;
begin
   if csDestroying in ComponentState then exit;
   if (csPaintCopy in ControlState) and
      Assigned(FDataLink.Field) and FDataLink.Field.IsBlob then
   begin
      Canvas.Brush.Color:=TEdit(parent).color;
      Canvas.FillRect(ClientRect);
//    Canvas.Brush.Style := bsClear;
      tempImager := TfcImager.create(self);
      tempImager.height:= height;
      tempImager.width:=width;
      tempImager.picture.assign(FDataLink.Field);
      tempImager.transparent:=Transparent;

      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
   else begin
   end;

      Canvas.Brush.Color:=clWhite;
      Canvas.FillRect(ClientRect);
   inherited;
   Form := GetParentForm(Self);
   if (Form <> nil) and (FWinControl<>nil) and
    (Form.ActiveControl = FWinControl) and
     not (csDesigning in ComponentState) and
     not (csPaintCopy in ControlState) then
   begin
     Canvas.Brush.Color := clWindowFrame;
     Canvas.FrameRect(ClientRect);
   end;
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;

end.