Форум: "Основная";
Текущий архив: 2008.08.17;
Скачать: [xml.tar.bz2];
Внизподскажите компонент Найти похожие ветки
← →
LexXL (2007-12-04 13:54) [0]подскажите компонент для маштабирования изображений
← →
kami (2007-12-04 13:59) [1]imgaspect к примеру - на торри.нет
← →
Rouse_ © (2007-12-04 14:09) [2]Да его писать то :)
unit FWImage;
interface
uses
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;
implementation
procedure 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.
← →
Правильный_Вася (2007-12-04 14:16) [3]
> Rouse_ © (04.12.07 14:09) [2]
а если не битмап, а векторное что-то, а?
← →
Rouse_ © (2007-12-04 15:00) [4]Вектор? Эээ... Метафайл векторный? (я с метафайлами просто никогда не работал :)
Да ну и битмап - это промежуточный, т.е. он отобразит все что может подгрузить TPicture :)
← →
tesseract © (2007-12-04 15:03) [5]
> Вектор? Эээ... Метафайл векторный? (я с метафайлами просто
> никогда не работал :)
Да он векторный.
← →
DVM © (2007-12-04 15:52) [6]WMF это формат файла. Не более.
Он векторный, но рисование на нем ничем не отличается от рисования на растре. Также на канву выводятся линии, прямоугольники и прочее. Просто потом запоминаются не точки изображения, а параметры того что рисовали.
← →
Eraser © (2007-12-04 15:57) [7]
> LexXL (04.12.07 13:54)
StretchBlt.
← →
Sapersky (2007-12-04 16:35) [8]Вместо StretchBlt лучше Canvas.StretchDraw(DstRect, FPicture.Graphic).
В этом случае метафайл должен отмасштабироваться векторно (вызовется TMetafile.Draw -> PlayEnhMetaFile).
← →
Eraser © (2007-12-04 16:49) [9]непонятно другое - зачем тут вообще вектор?
← →
Правильный_Вася (2007-12-04 18:41) [10]
> зачем тут вообще вектор?
изображения разные бывают
автор-то не уточняет
можеТ, у него вообще в зеркале
Страницы: 1 вся ветка
Форум: "Основная";
Текущий архив: 2008.08.17;
Скачать: [xml.tar.bz2];
Память: 0.48 MB
Время: 0.04 c