| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150 |
- {========================================================================}
- {= (c) 1995-98 SwiftSoft Ronald Dittrich =}
- {========================================================================}
- {= All Rights Reserved =}
- {========================================================================}
- {= D 01099 Dresden = Tel.: +0351-8012255 =}
- {= Loewenstr.7a = info@swiftsoft.de =}
- {========================================================================}
- {= Actual versions on http://www.swiftsoft.de/mmtools.html =}
- {========================================================================}
- {= This code is for reference purposes only and may not be copied or =}
- {= distributed in any format electronic or otherwise except one copy =}
- {= for backup purposes. =}
- {= =}
- {= No Delphi Component Kit or Component individually or in a collection=}
- {= subclassed or otherwise from the code in this unit, or associated =}
- {= .pas, .dfm, .dcu, .asm or .obj files may be sold or distributed =}
- {= without express permission from SwiftSoft. =}
- {= =}
- {= For more licence informations please refer to the associated =}
- {= HelpFile. =}
- {========================================================================}
- {= $Date: 20.01.1998 - 18:00:00 $ =}
- {========================================================================}
- unit MMDIBCv;
- {$I COMPILER.INC}
- {$IFNDEF WIN32}
- {$DEFINE USEWING}
- {$ENDIF}
- interface
- uses
- {$IFDEF WIN32}
- Windows,
- {$ELSE}
- WinTypes,
- WinProcs,
- {$ENDIF}
- Classes,
- Controls,
- Graphics,
- Dialogs,
- SysUtils,
- MMObj,
- MMUtils,
- MMDIB,
- CRightC
- {$IFDEF USEWING}
- ,MMWinG
- {$ENDIF};
- const
- { different DIB Orientations }
- DIB_TOPDOWN = -1;
- DIB_BOTTOMUP = 1;
- { DIB_TOPDOWN is the fastest, but many drivers can't work with }
- { this STANDARD format. For example the ATI driver causes a GPF }
- { in BitBlt. NEVER buy a ATI card, if you would have trouble do it!}
- DIB_ORIENT: integer = DIB_BOTTOMUP; { Bottom - Up DIB !! }
- type
- EMMDIBError = class(Exception);
- {-- TMMDIBCanvas ----------------------------------------------------}
- TMMDIBCanvas = class(TCanvas)
- public
- constructor Create; virtual;
- destructor Destroy; override;
- procedure SetBounds(aLeft, aTop, aWidth, aHeight: Integer); virtual;
- procedure SetLogPalette(pLogPal: PLogPalette);
- procedure DIB_Init;
- procedure DIB_InitDrawing;
- procedure DIB_DoneDrawing;
- procedure DIB_SetTColor(Color: TColor);
- procedure DIB_SetColorRef(ColorRef: Longint);
- function DIB_ColorToIndex(Color: TColor): Longint;
- procedure DIB_SetColor(Index: Longint);
- procedure DIB_SetClipRect(R: TRect);
- function DIB_GetClipRect: TRect;
- function DIB_GetPixelAddress(aSurface: Pointer; X, Y: integer): Pointer;
- procedure DIB_SetPixel(X, Y: integer; Color: Longint);{$IFDEF WIN32}pascal;{$ENDIF}
- function DIB_GetPixel(X, Y: integer): Longint;{$IFDEF WIN32}pascal;{$ENDIF}
- procedure DIB_Line(X1, Y1, X2, Y2: integer);{$IFDEF WIN32}pascal;{$ENDIF}
- procedure DIB_LineNotXor(X1, Y1, X2, Y2: integer);{$IFDEF WIN32}pascal;{$ENDIF}
- procedure DIB_MoveTo(X,Y: integer);{$IFDEF WIN32}pascal;{$ENDIF}
- procedure DIB_LineTo(X,Y: integer);{$IFDEF WIN32}pascal;{$ENDIF}
- procedure DIB_HLine(X1, X2, Y: integer);{$IFDEF WIN32}pascal;{$ENDIF}
- procedure DIB_HLineDashed(X1, X2, Y: integer);{$IFDEF WIN32}pascal;{$ENDIF}
- procedure DIB_HLineDoted(X1, X2, Y, Steps: integer);{$IFDEF WIN32}pascal;{$ENDIF}
- procedure DIB_VLine(X, Y1, Y2: integer);{$IFDEF WIN32}pascal;{$ENDIF}
- procedure DIB_VLineXor(X, Y1, Y2: integer);{$IFDEF WIN32}pascal;{$ENDIF}
- procedure DIB_VLineNotXor(X, Y1, Y2: integer);{$IFDEF WIN32}pascal;{$ENDIF}
- procedure DIB_VLineDashed(X, Y1, Y2: integer);{$IFDEF WIN32}pascal;{$ENDIF}
- procedure DIB_VLineDoted(X, Y1, Y2, Steps: integer);{$IFDEF WIN32}pascal;{$ENDIF}
- procedure DIB_VLineMultiColor(X, Y: integer; Colors: PByte; Cnt: integer);{$IFDEF WIN32}pascal;{$ENDIF}
- procedure DIB_Rectangle(X1, Y1, X2, Y2: integer);{$IFDEF WIN32}pascal;{$ENDIF}
- procedure DIB_FillRect(Rect: TRect);{$IFDEF WIN32}pascal;{$ENDIF}
- procedure DIB_FillRectXor(Rect: TRect);{$IFDEF WIN32}pascal;{$ENDIF}
- procedure DIB_FillRectDoted(Rect: TRect; Doted: Boolean);{$IFDEF WIN32}pascal;{$ENDIF}
- procedure DIB_Ellipse(X, Y: integer; StAngle, EndAngle, XRadius, YRadius: Word);{$IFDEF WIN32}pascal;{$ENDIF}
- procedure DIB_FillEllipse(X, Y: integer; XRadius, YRadius: Word);{$IFDEF WIN32}pascal;{$ENDIF}
- procedure DIB_Clear;{$IFDEF WIN32}pascal;{$ENDIF}
- procedure DIB_CopyDIBBits(Source:Pointer;XDst,YDst,Width,Height,XSrc,YSrc: integer);{$IFDEF WIN32}pascal;{$ENDIF}
- procedure DIB_BitBlt(DestDC: THandle; Dest: TRect; X, Y: integer);
- procedure DIB_StretchBlt(DestDC: THandle; Dest: TRect; Src: TRect);
- procedure BeginAnimate;
- procedure EndAnimate;
- property Surface: Pointer read FPSurface;
- property BackSurface: Pointer read FPBackSurface;
- property BitmapInfo: PBitmapInfo read FPBitmapInfo;
- property Bitmap: HBitmap read FHBitmap;
- property Palette: HPalette read FHPalette;
- property AnimatedColorCount: Integer read GetAnimCount write SetAnimCount;
- property AnimatedColor[i: Integer]: TColor read GetAnimColor;
- property AnimatedColorValue[i: Integer]: TColor read GetAnimColorValue write SetAnimColorValue;
- property AnimatedColorIndex[i: Integer]: Integer read GetAnimColorIndex ;
- published
- property BitsPerPixel: integer read FBits write SetBPP stored True;
- property PaletteRealize: Boolean read FRealize write SetRealize default False;
- property PaletteMapped: Boolean read FMapped write SetMapped default False;
- property BackGroundBitmap: TBitmap read FBackBitmap write SetBackBitmap;
- property Width: integer read FWidth write SetWidth default 1;
- property Height: integer read FHeight write SetHeight default 1;
- end;
- {-- TMMDIBGraphicControl --------------------------------------------}
- TMMDIBGraphicControl = class(TMMGraphicControl)
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- procedure DrawBackGround;
- property DIBCanvas: TMMDIBCanvas read FDIBCanvas write FDIBCanvas;
- property BitsPerPixel: integer read GetBPP write SetBPP default 8;
- end;
- implementation
|