archive-com.com » COM » E » EFG2.COM

Total: 878

Choose link from "Titles, links and description words view":

Or switch to "Titles and links view".

  • TWMPaletteChanged message WM PALETTECHANGED procedure WMQueryNewPalette var Msg TWMQueryNewPalette message WM QUERYNEWPALETTE public Public declarations end var Form1 TForm1 implementation R DFM procedure TForm1 FormCreate Sender TObject var FileName String begin FPaletteHandlingMethod phmSpecific one of phmOriginal phmGeneric phmSpecific FileName ExtractFilePath Application ExeName web bmp FBitmap TBitmap Create FBitmap LoadFromFile FileName Application OnDeactivate ApplicationDeactivate end procedure TForm1 FormDestroy Sender TObject begin FBitmap Free end procedure TForm1 FormShow Sender TObject begin SetWindowPos Handle HWND TOPMOST 0 0 0 0 SWP NOSIZE or SWP NOMOVE end procedure TForm1 ApplicationDeactivate Sender TObject begin SetWindowPos Handle HWND TOPMOST 0 0 0 0 SWP NOACTIVATE or SWP NOSIZE or SWP NOMOVE end procedure TForm1 PaintBox1Paint Sender TObject begin Sender as TPaintBox Canvas Draw 0 0 FBitmap end procedure TForm1 WMQueryNewPalette var Msg TWMQueryNewPalette begin case FPaletteHandlingMethod of phmOriginal WMQueryNewPalette1 Msg phmGeneric WMQueryNewPalette2 Msg phmSpecific WMQueryNewPalette3 Msg else WMQueryNewPalette1 Msg end end procedure TForm1 WMPaletteChanged var Msg TWMPaletteChanged begin case FPaletteHandlingMethod of phmOriginal WMPaletteChanged1 Msg phmGeneric WMPaletteChanged2 Msg phmSpecific WMPaletteChanged3 Msg else WMPaletteChanged1 Msg end end procedure TForm1 WMPaletteChanged1 var Msg TWMPaletteChanged var DC HDC OldPalette HPALETTE begin If the message was not generated by this window respond to it appropriately if Msg PalChg Handle then begin handle it for embedded windowed controls for Index ControlCount 1 downto 0 do begin Control Controls Index if Control is TWinControl then begin with TWinControl Control do begin DC GetDC Handle try Select our palette into the device context Save the palette that was in effect OldPalette SelectPalette DC FBitmap Palette true try Realise the palette Windows will map colours from our logical palette into the system palette The return value is the number of unique colours that it created in the system palette on our behalf Note that this will not change the 20 colours reserved for Windows itself RealizePalette DC UpdateColors is Microsoft s preferred method of refreshing an on screen Window if the system palette changes UpdateColors DC finally Restore the original palette into the device context before we release it SelectPalette DC OldPalette false end finally Release the device context that we got from Windows ReleaseDC Handle DC end end end end now for the form itself DC GetDC Handle try Select our palette into the device context Save the palette that was in effect OldPalette SelectPalette DC FBitmap Palette true try Realise the palette Windows will map colours from our logical palette into the system palette The return value is the number of unique colours that it created in the system palette on our behalf Note that this will not change the 20 colours reserved for Windows itself RealizePalette DC UpdateColors is Microsoft s preferred method of refreshing an on screen Window if the system palette changes UpdateColors DC finally Restore the original palette into the device context before we release it SelectPalette DC OldPalette false end finally Release the device context that we got from Windows ReleaseDC Handle DC end Msg Result 1 end Because the message was generated by this window it was

    Original URL path: http://www.efg2.com/Lab/Library/UseNet/2000/0106.txt (2016-02-14)
    Open archived version from archive



  • make the 24 bits image have only 256 colors so the only thing I have to do is to store the bitmap in a 8 bit format If you don t mind replacing your color reduction library you can use the ReduceColors function in my freeware TGIFImage library It produces 8 bit TBitmaps so all you have to do is var SourceBitmap DestBitmap TBitmap begin SourceBitmap TBitmap Create try SourceBitmap

    Original URL path: http://www.efg2.com/Lab/Library/UseNet/1999/0215.txt (2016-02-14)
    Open archived version from archive

  • Jean-Yves Queinec's Delphi Image Processing Page
    original image to the blurred image in order to recover lost details Other improvements Frequently pictures scanned with an old scanner shows saturation in red areas and darkness or patches of shadow in blue areas Green areas are generally correct The idea is to mix about 12 or more of green values into red values and blue values Result looks better but of course with less color saturation The saturation or contrast fonctions can restore color intensity The program offers the capability to restore a percentage of original read image function which is very useful to adjust intensity of some actions The special Light function is better than Correction gamma to obtain bright images such as the background image of this page Technical tips For more information about scanlines refer to the excellent efg s paper I use only pf24bit bitmaps because Jpg images are pf24bit Instead of efg s arithmetic on scanlines pointers I store bitmap scanlines in arrays of scanlines bitmaps limited to 2048 lines to optimize the process when several lines are used to compute new pixel color values This Delphi 3 demo program see below is simple but fully operational and can be used as a

    Original URL path: http://www.efg2.com/Lab/Library/Delphi/Graphics/Queinec/EstampeDemo/EstampeDemo.htm (2016-02-14)
    Open archived version from archive


  • stellt auch die beleuchteten und die Schatten Partien in einer passenden Farbe dar Um diese Farben zu berechnen verwendet sie die Get3DColors Routine aus meiner rrColors Unit die von meiner Homepage siehe unten heruntergeladen werden kann Das Zeichnen ist relativ langsam da intern 3 mal eine transparente Bitmap von der Groesse des Buttons gezeichnet werden muss und transparente Bitmaps ohnehin nicht mit Rechenzeit geizen Hier waere etwas Tuning angebracht aber im Moment habe ich dazu keine Lust Solange du nicht Dutzende von Buttons auf dem Bildschirm hast sollte der gegenwaertige Zustand noch akzeptabel sein Gruss Robert Author Robert Rossmair Wagelwitz Rodaer Str 6 04688 Mutzschen Germany e mail Robert Rossmair t online de http home t online de home Robert Rossmair Module ClrSpBtn Version 0 9 11 Jun 1999 Description Implements TColorSpeedBtn a TSpeedButton descendant which has a Color property Remarks Quick hack painting needs some speed tuning History None Compatibility Delphi 3 Copyright 1999 Robert Rossmair Use modification and distribution is allowed without limitation warranty or liability of any kind If you use this software or portions of it in a commercial program I would appreciate it if you mentioned my contribution in the documentation materials accompaning your work unit ClrSpBtn interface uses Windows Messages SysUtils Classes Graphics Controls Forms Dialogs Buttons rrColors type TColorSpeedBtn class TSpeedButton private procedure WMPaint var Message TWMPaint message WM PAINT published property Color property ParentColor end procedure Register implementation procedure Register begin RegisterComponents 3rdParty TColorSpeedBtn end procedure TColorSpeedBtn WMPaint var Message TWMPaint var Bmp Bmp2 TBitmap W H Integer R TRect HighlightColor ShadowColor TColor begin if Flat then inherited else if Message DC 0 then begin Canvas Lock try Bmp TBitmap Create try W Width H Height R Rect 0 0 W H Bmp Width W Bmp Height H Bmp Transparent True Canvas

    Original URL path: http://www.efg2.com/Lab/Library/UseNet/1999/0611b.txt (2016-02-14)
    Open archived version from archive


  • If you are using 24 bit color then reversing the color bits via XOR works for many color combinations but not all You generally get a color whose values are significantly different but that does not neccessarily make them readable If you are in grey scale the opposite of a medium grey turns out to also be a medium grey So what you might really need is some control over

    Original URL path: http://www.efg2.com/Lab/Library/UseNet/1999/0519b.txt (2016-02-14)
    Open archived version from archive


  • may be of use By Gustavo Daud procedure DrawAAText Dest TBitmap DX DY Integer Text String type pRGBLine TRGBLine TRGBLine Array Word of TRGBTriple Separate R G and B values from the color procedure SeparateColor Color TColor var r Byte var g byte var b byte begin R Color and FF0000 shr 16 G Color and 00FF00 shr 8 B Color and 0000FF end var TempBitmap TBitmap x y Integer totr totg totb Integer j i Integer Line pRGBLine TempLine Array 0 1 of pRGBLine begin Creates a temporary bitmap do work with supersampling TempBitmap TBitmap Create with TempBitmap do begin PixelFormat pf24bit Copy attributes from previous bitmap Canvas Font Assign Dest Canvas Font Canvas Brush Assign Dest Canvas Brush Canvas Pen Assign Dest Canvas Pen Canvas Font Size Canvas Font Size 2 Make it twice larger to apply supersampling later Width Canvas TextWidth Text Height Canvas TextHeight Text To prevent unexpected junk if Width div 2 DX Dest Width then Width Dest Width DX 2 if Height div 2 DY Dest Height then Height Dest Height DY 2 If the brush style is clear then copy the image from the previous image to create the propher effect if Canvas Brush Style bsClear then begin Canvas Draw DX DY Dest Canvas Stretchdraw Rect 0 0 Width 2 Height 2 TempBitmap end Draws the text using double size Canvas TextOut 0 0 Text end Draws the antialiased image for y 0 to TempBitmap Height div 2 1 do begin If the y pixel is outside the clipping region do the proper action if dy y Dest Height 1 then Break Scanline for faster access Line Dest ScanLine DY y TempLine 0 TempBitmap Scanline 2 y TempLine 1 TempBitmap Scanline 2 y 1 for x 0 to TempBitmap Width div 2 1

    Original URL path: http://www.efg2.com/Lab/Library/UseNet/2001/0606a.txt (2016-02-14)
    Open archived version from archive


  • uses Windows Messages SysUtils Classes Graphics Controls Forms Dialogs type TForm1 class TForm procedure FormCreate Sender TObject procedure FormDestroy Sender TObject private SmoothFonts Boolean public end var Form1 TForm1 implementation R DFM procedure TForm1 FormCreate Sender TObject begin SystemParametersInfo SPI GETFONTSMOOTHING 1 SmoothFonts 0 if SmoothFonts then SystemParametersInfo SPI SETFONTSMOOTHING 0 nil SPIF UPDATEINIFILE end procedure TForm1 FormDestroy Sender TObject begin if SmoothFonts then SystemParametersInfo SPI SETFONTSMOOTHING 1 nil SPIF

    Original URL path: http://www.efg2.com/Lab/Library/UseNet/2000/0101a.txt (2016-02-14)
    Open archived version from archive


  • ButtonProportionalArrowClick Sender TObject VAR Bitmap TBitmap x1 x2 INTEGER y1 y2 INTEGER xbase INTEGER xDelta INTEGER ybase INTEGER yDelta INTEGER begin Bitmap TBitmap Create TRY Bitmap Width 512 Bitmap Height 512 Bitmap PixelFormat pf24bit Bitmap Canvas Pen Color clRed x1 100 first point y1 100 x2 350 second point with arrow y2 400 Bitmap Canvas MoveTo x1 y1 Bitmap Canvas LineTo x2 y2 xBase x1 MulDiv x2 x1 9 10 90 from x1 y1 to x2 y2 yBase y1 MulDiv y2 y1 9 10 xDelta x2 xBase yDelta y2 yBase base of arrow tip is perpendicular to original vector A normal vector to the original line can be found by swapping the delta X and delta Y components and negating one of them Draw the arrow tip Bitmap Canvas Polygon Point x2 y2 Point xBase yDelta yBase xDelta Point xBase yDelta yBase xDelta ImageShow Picture Graphic Bitmap FINALLY Bitmap Free END end 2 Fixed Head Arrow procedure TForm1 ButtonFixeHeadArrowClick Sender TObject VAR Bitmap TBitmap HeadLength INTEGER x1 x2 INTEGER y1 y2 INTEGER xbase INTEGER xLineDelta INTEGER xLineUnitDelta Double xNormalDelta INTEGER xNormalUnitDelta Double ybase INTEGER yLineDelta INTEGER yLineUnitDelta Double yNormalDelta INTEGER yNormalUnitDelta Double begin Bitmap TBitmap Create TRY Bitmap Width 512

    Original URL path: http://www.efg2.com/Lab/Library/Delphi/Graphics/Arrow.Txt (2016-02-14)
    Open archived version from archive



  •