Платные хостинги     Раскрутка сайта     Книги по программированию

Сдвиг в TImage, Помогите, пожалуйста!

- Привет всем участникам форума! Подскажите, пожалуйста, как можно сделать такое: есть компонент TImage небольшого размера и картинка размера намного большего, чем сам компонент. Как можно в этом компоненте отобразить картинку не с ее верхнего левого угла, а например с точки (100, 200) от начала (левый верхний угол). Спасибо...

- Это пойдет?Код ////////////////////////////////////////////////////////////////////////////////////  ****************************************************************************//  * Unit Name : FWImage//  * Purpose   : демонстроционный компонент - аналог TImage с возможностью скролирования//  * Author    : Александр Багель//  * Version   : 1.00//  ****************************************************************************//unit FWImage;interfaceuses  Windows, Messages, Controls, Classes, SysUtils, Graphics, Forms;type  TFWImage = class(TGraphicControl)  private    FPicture: TPicture;    FX, FY, FBX, FBY: Integer;    BitMap: TBitmap;    FZoom: Byte;    procedure SetPicture(const Value: TPicture);    procedure WMLButtonDown(var Message: TMessage); message WM_LBUTTONDOWN;    procedure WMMouseMove(var Message: TMessage); message WM_MOUSEMOVE;    procedure WMEraseBkgnd(var Message: TMessage); message WM_ERASEBKGND;    procedure SetZoom(const Value: Byte);  protected    procedure PictureChanged(Sender: TObject);    procedure Paint; override;  public    constructor Create(AOwner: TComponent); override;    destructor Destroy; override;  published    property Picture: TPicture read FPicture write SetPicture;    property Zoom: Byte read FZoom write SetZoom;  end;procedure Register;implementationprocedure Register;begin  RegisterComponents('Samples', [TFWImage]);end;{ TFWImage }constructor TFWImage.Create(AOwner: TComponent);begin  inherited Create(AOwner);  FPicture := TPicture.Create;  FPicture.OnChange := PictureChanged;  Height := 105;  Width := 105;  BitMap := TBitmap.Create;  FZoom := 1;end;destructor TFWImage.Destroy;begin  FPicture.Free;  BitMap.Free;  inherited;end;procedure TFWImage.Paint;begin  inherited;  Canvas.Lock;  if csDesigning in ComponentState then    with Canvas do    begin      Pen.Style := psDash;      Pen.Color := clBlack;      Brush.Style := bsClear;      Rectangle(0, 0, Width, Height);    end;  if Assigned(FPicture) then    if FZoom = 1 then      BitBlt(Canvas.Handle, 0, 0, Width, Height, Bitmap.Canvas.Handle, FX, FY, SRCCOPY)    else      StretchBlt(Canvas.Handle, 0, 0, Width, Height, Bitmap.Canvas.Handle,        FX, FY, Width div FZoom, Height div FZoom, SRCCOPY);  Canvas.Unlock;end;procedure TFWImage.PictureChanged(Sender: TObject);begin  Bitmap.Assign(FPicture.Graphic);  Invalidate;end;procedure TFWImage.SetPicture(const Value: TPicture);begin  FPicture.Assign(Value);end;procedure TFWImage.SetZoom(const Value: Byte);begin  if FZoom <> Value then  begin    FZoom := Value;    if FZoom = 0 then FZoom := 1;    invalidate;  end;end;procedure TFWImage.WMEraseBkgnd(var Message: TMessage);begin  Message.Result := 0;end;procedure TFWImage.WMLButtonDown(var Message: TMessage);begin  with Message do  begin    FBX := LParamLo + FX * FZoom;    FBY := LParamHi + FY * FZoom;  end;  inherited;end;procedure TFWImage.WMMouseMove(var Message: TMessage);var  L, H: Integer;begin  inherited;  with Message do  begin    if KeysToShiftState(WParam) = [ssLeft] then    begin      L:= LParamLo;      H:= LParamHi;      if L > 65000 then L := L - 65535;      if H > 65000 then H := H - 65535;      FX := (FBX - L) div FZoom;      FY := (FBY - H) div FZoom;      if FX > Picture.Width - (Width div FZoom) then        FX := Picture.Width - (Width div FZoom);      if FY > Picture.Height - (Height div FZoom) then        FY := Picture.Height - (Height div FZoom);      if FX<0 then FX := 0;      if FY<0 then FY := 0;      Paint;    end;  end;end;end.highlightSyntax('delphiE2OTRl','delphi');

- Все хорошо! А еще какие-нибудь способы есть, без ввода дополнительного компонента?

- Ну так BitBlt

- Так вот я и не пойму, что это такое?

- И не поймешь, если не почитаешь справку по данной функции...

- Красиво сказал...Вот выдержка из справки:Цитата The BitBlt function performs a bit-block transfer of the color data corresponding to a rectangle of pixels from the specified source device context into a destination device context. BOOL BitBlt(    HDC hdcDest, // handle to destination device context     int nXDest, // x-coordinate of destination rectangle's upper-left corner    int nYDest, // y-coordinate of destination rectangle's upper-left corner    int nWidth, // width of destination rectangle     int nHeight, // height of destination rectangle     HDC hdcSrc, // handle to source device context     int nXSrc, // x-coordinate of source rectangle's upper-left corner      int nYSrc, // y-coordinate of source rectangle's upper-left corner    DWORD dwRop  // raster operation code   ); ParametershdcDestIdentifies the destination device context. nXDestSpecifies the logical x-coordinate of the upper-left corner of the destination rectangle.nYDestSpecifies the logical y-coordinate of the upper-left corner of the destination rectangle. nWidthSpecifies the logical width of the source and destination rectangles. nHeightSpecifies the logical height of the source and the destination rectangles. hdcSrcIdentifies the source device context. nXSrcSpecifies the logical x-coordinate of the upper-left corner of the source rectangle. nYSrcSpecifies the logical y-coordinate of the upper-left corner of the source rectangle. dwRopSpecifies a raster-operation code. These codes define how the color data for the source rectangle is to be combined with the color data for the destination rectangle to achieve the final color. The following list shows some common raster operation codes: Value DescriptionBLACKNESS Fills the destination rectangle using the color associated with index 0 in the physical palette. (This color is black for the default physical palette.)DSTINVERT Inverts the destination rectangle.MERGECOPY Merges the colors of the source rectangle with the specified pattern by using the Boolean AND operator.MERGEPAINT Merges the colors of the inverted source rectangle with the colors of the destination rectangle by using the Boolean OR operator.NOTSRCCOPY Copies the inverted source rectangle to the destination.NOTSRCERASE Combines the colors of the source and destination rectangles by using the Boolean OR operator and then inverts the resultant color.PATCOPY Copies the specified pattern into the destination bitmap.PATINVERT Combines the colors of the specified pattern with the colors of the destination rectangle by using the Boolean XOR operator.PATPAINT Combines the colors of the pattern with the colors of the inverted source rectangle by using the Boolean OR operator. The result of this operation is combined with the colors of the destination rectangle by using the Boolean OR operator.SRCAND Combines the colors of the source and destination rectangles by using the Boolean AND operator.SRCCOPY Copies the source rectangle directly to the destination rectangle.SRCERASE Combines the inverted colors of the destination rectangle with the colors of the source rectangle by using the Boolean AND operator.SRCINVERT Combines the colors of the source and destination rectangles by using the Boolean XOR operator.SRCPAINT Combines the colors of the source and destination rectangles by using the Boolean OR operator.WHITENESS Fills the destination rectangle using the color associated with index 1 in the physical palette. (This color is white for the default physical palette.) Return ValuesIf the function succeeds, the return value is nonzero.If the function fails, the return value is zero. To get extended error information, call GetLastError. RemarksIf a rotation or shear transformation is in effect in the source device context, BitBlt returns an error. If other transformations exist in the source device context (and a matching transformation is not in effect in the destination device context), the rectangle in the destination device context is stretched, compressed, or rotated as necessary. If the color formats of the source and destination device contexts do not match, the BitBlt function converts the source color format to match the destination format. When an enhanced metafile is being recorded, an error occurs if the source device context identifies an enhanced-metafile device context. Not all devices support the BitBlt function. For more information, see the RC_BITBLT raster capability entry in GetDeviceCaps. BitBlt returns an error if the source and destination device contexts represent different devices. Ну и что? Все понятно? Вопрос срочный, а что-то никто помочь не может! Сорри, если кого-то обидел!

- Не получилось прикрепить весь проект, но код я всё таки выложу здесь:Unit1.pasКод unit Unit1;interfaceuses  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,  Dialogs, jpeg, ExtCtrls, StdCtrls;type  TForm1 = class(TForm)    Image1: TImage;    Image2: TImage;    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,      Y: Integer);  private    { Private declarations }  public    { Public declarations }  end;var  Form1: TForm1;implementation{$R *.dfm}procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,  Y: Integer);begin  if (ssCtrl in shift) then    BitBlt(Image2.Canvas.Handle, 0, 0, Image2.Width, Image2.Height, Image1.Canvas.Handle, X, Y, SRCCOPY);  Image2.Refresh;end;end.highlightSyntax('delphiMzM0Mz','delphi');На форме 2 TImage: Image1 - большая картинка, Image2 - маленькая картинка. Это сообщение отредактировал Yanis - 12.5.2005, 23:41

- Yanis, очень полезный совет! Спасибо! +1 к репутации!

- А возможно ли сделать как-нибудь такое: нажимаю и удерживаю левую кнопку мыши на небьольшом компоненте TImage и начинаю водить мышкой. Таким образом начальная картинка сдвигается влево/вправо/вверх/вниз в зависимости от того, куда я потянул мышу. Можно? И если да, от как? Спасибо...

- Вот целый готовый компонент. Там можно посмотреть принцип:http://forum.vingrad.ru/index.php?showtopic=45912А вот я когда-то писал что-то подобное:Код unit ImgFrm;interfaceuses  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,  ExtCtrls;type  TImageFrame = class(TFrame)    Image: TImage;    procedure ImageMouseDown(Sender: TObject; Button: TMouseButton;      Shift: TShiftState; X, Y: Integer);    procedure ImageMouseMove(Sender: TObject; Shift: TShiftState; X,      Y: Integer);    procedure ImageMouseUp(Sender: TObject; Button: TMouseButton;      Shift: TShiftState; X, Y: Integer);    procedure HandleKeyDown(var Key: Word; Shift: TShiftState);    procedure FrameResize(Sender: TObject);  private    FMouseDown, FScrollEnabled: Boolean;    FX, FY: Integer;    procedure SetDefImageBounds;    procedure SetWidthAndHeight;  public    constructor Create(AOwner: TComponent); override;    procedure LoadImage(const FileName: string);    procedure ScrollImage(const DX, DY: Integer);  end;implementation{$R *.DFM}const  crHand = 1;  crDrag = 2;constructor TImageFrame.Create(AOwner: TComponent);begin  inherited Create(AOwner);  ControlStyle := ControlStyle + [csOpaque];end;procedure TImageFrame.SetWidthAndHeight;var  W, H: Integer;begin  W := Image.Picture.Width;  H := Image.Picture.Height;  Image.Center := (W < ClientWidth) or (H < ClientHeight);  if W < ClientWidth then W := ClientWidth;  if H < ClientHeight then H := ClientHeight;  FScrollEnabled := (W <> ClientWidth) or (H <> ClientHeight);  if FScrollEnabled then    Image.Cursor := crHand  else    Image.Cursor := crDefault;  Image.SetBounds(Image.Left, Image.Top, W, H);end;procedure TImageFrame.SetDefImageBounds;begin  Image.Left := 0;  Image.Top  := 0;  SetWidthAndHeight;end;procedure TImageFrame.LoadImage(const FileName: string);begin  Image.Picture.LoadFromFile(FileName);  SetDefImageBounds;  InValidateRect(Handle, nil, True);end;procedure TImageFrame.ScrollImage(const DX, DY: Integer);var  L, T: Integer;begin  L := Image.Left;  T := Image.Top;  if DX <> 0 then L := L + DX;  if DY <> 0 then T := T + DY;  if L > 0 then L := 0 else    if Image.Width + L < ClientWidth then L := ClientWidth - Image.Width;  if T > 0 then T := 0 else    if Image.Height + T < ClientHeight then T := ClientHeight - Image.Height;  if (L <> Image.Left) or     (T <> Image.Top) then    Image.SetBounds(L, T, Image.Width, Image.Height);end;procedure TImageFrame.ImageMouseDown(Sender: TObject; Button: TMouseButton;  Shift: TShiftState; X, Y: Integer);begin  if (Button = mbLeft) and FScrollEnabled then  begin    Screen.Cursor := crDrag;    FMouseDown := True;    FX := X;    FY := Y;  end;end;procedure TImageFrame.ImageMouseMove(Sender: TObject; Shift: TShiftState; X,  Y: Integer);begin  if FMouseDown then ScrollImage(X - FX, Y - FY)end;procedure TImageFrame.ImageMouseUp(Sender: TObject; Button: TMouseButton;  Shift: TShiftState; X, Y: Integer);begin  if Button = mbLeft then  begin    Screen.Cursor := crDefault;    FMouseDown := False;  end;end;procedure TImageFrame.FrameResize(Sender: TObject);begin  SetWidthAndHeight;  if Image.Width + Image.Left < ClientWidth then    Image.Left := ClientWidth - Image.Width;  if Image.Height + Image.Top < ClientHeight then    Image.Top := ClientHeight - Image.Height;  InValidateRect(Handle, nil, True);end;initialization  Screen.Cursors[crHand] := LoadCursor(HInstance, 'HAND');  Screen.Cursors[crDrag] := LoadCursor(HInstance, 'DRAG');end.highlightSyntax('delphiMjkxNT','delphi');Хоть это и фрейм, но естественно можно применить и для форм.

Интернет казино     Онлайн игры     Увеличение члена     Купить DVD