Never been to CodeSnippets before?

Snippets is a public source code repository. Easily build up your personal collection of code snippets, categorize them with tags / keywords, and share them with the world (or not, you can keep them private!)

Show baloon hint in delphi

// Function to show baloon hint
// (found on pl.comp.lang.delphi newsgroup - posted by spook)

function ShowBaloonHint(Point: TPoint; Handle: THandle; Title: String;
Msg: String; Icon: Integer): Boolean;
var
  hwnd: THandle;
  ti: TToolInfo;
  hCursor: THandle;
  Rect: TRect;
  IconData: TNotifyIconData;

const
  TTS_BALLOON = $40;
  TTS_CLOSE = $80;

  procedure SetToolTipTitle(tt: THandle; IconType: Integer; Title: string);
  var
    buffer: array[0..255] of Char;
  const
    TTM_SETTITLE = (WM_USER + 32);
  begin
    FillChar(buffer, SizeOf(buffer), #0);
    lstrcpy(buffer, PChar(Title));
    SendMessage(tt, TTM_SETTITLE, IconType, Integer(@buffer));
  end;

begin
  hwnd:= CreateWindowEx(0,
                        TOOLTIPS_CLASS,
                        nil,
                        TTS_ALWAYSTIP or TTS_BALLOON or TTS_CLOSE,
                        CW_USEDEFAULT,
                        CW_USEDEFAULT,
                        CW_USEDEFAULT,
                        CW_USEDEFAULT,
                        Application.MainForm.Handle,
                        0,
                        Application.Handle,
                        0);

  SetWindowPos( hwnd,
                HWND_TOPMOST,
                0,
                0,
                0,
                0,
                SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE);

  GetClientRect(Handle, Rect);

  with ti do
    begin
      cbSize:= Sizeof(TToolInfo);
      uFlags:= TTF_TRACK;
      hwnd:= Handle;
      hInst:= Application.Handle;
      uId:= Handle;
      lpszText:= PChar(Msg);
    end;

  ti.Rect.Left:= Rect.Left;
  ti.Rect.Top:= Rect.Top;
  ti.Rect.Right:= Rect.Right;
  ti.Rect.Bottom:= Rect.Bottom;

  SendMessage(hwnd,TTM_ADDTOOL,1,Integer(@ti));
  SetToolTipTitle(hwnd,Icon,Title);

  SendMessage(hwnd, TTM_TRACKPOSITION, 0, MakeLParam(Point.x,Point.y));

  SendMessage(hwnd, TTM_TRACKACTIVATE, Integer(True), Integer(@ti));
end; 

Zmiana wartości RGB z blokadą przepełnienia

procedure ChangeRGB(var Bitmap:TBitmap;R,G,B:integer);
var
H,V:integer;
DstRow:^TRGBTriple; // to jest wskaźnik dopixela
begin
 Bitmap.PixelFormat:=pf24bit;
 for V:=0 to Bitmap.Height -1 do
  begin
      DstRow:=Bitmap.ScanLine[V];
      for H:=0 to Bitmap.Width -1 do
      begin
      DstRow^:=ChangeRGBColor(DStrow^,R,G,B);
       Inc(DstRow);
     end;
  end;
end;

Flaxen

procedure Flaxen( Bitmap:TBitmap);
var
H,V:Integer;
WSK,WSK2,WSK3:^TRGBTriple;

begin
Bitmap.PixelFormat:=pf24bit;
for V:=0 to Bitmap.Height-1 do
  begin
Wsk:=Bitmap.ScanLine[V];
Wsk2:=Wsk;
Wsk3:=Wsk;
inc(Wsk2);
inc(Wsk3,2);

for H:=0 to Bitmap.Width -1 do
    begin
    Wsk.rgbtRed  := (Wsk.rgbtRed + Wsk2.rgbtGreen  +
    Wsk3.rgbtBlue) div 3;
    Wsk2.rgbtGreen := (Wsk.rgbtGreen + Wsk2.rgbtGreen +
    Wsk3.rgbtBlue) div 3;
    Wsk2.rgbtBlue := (Wsk.rgbtBlue + Wsk2.rgbtGreen +
    Wsk3.rgbtBlue) div 3;
    inc(Wsk);inc(Wsk2);inc(Wsk3);
    end;
  end;
end;

Emboss

procedure Emboss(Bitmap : TBitmap; AMount : Integer);
   var
   x, y, i : integer;
  p1, p2: PByteArray;
begin
  for i := 0 to AMount do
  begin
    for y := 0 to Bitmap.Height-2 do
    begin
      p1 := Bitmap.ScanLine[y];
      p2 := Bitmap.ScanLine[y+1];
      for x := 0 to Bitmap.Width do
      begin
        p1[x*3] := (p1[x*3]+(p2[(x+3)*3] xor $FF)) shr 1;
        p1[x*3+1] := (p1[x*3+1]+(p2[(x+3)*3+1] xor $FF)) shr 1;
        p1[x*3+2] := (p1[x*3+1]+(p2[(x+3)*3+1] xor $FF)) shr 1;
      end;
    end;
  end;
end;

Mono Noise

procedure MonoNoise(var Bitmap: TBitmap; Amount: Integer);
var
Row:^TRGBTriple;
H,V,a: Integer;
begin
  for V:=0 to Bitmap.Height-1 do
  begin
    Row:=Bitmap.ScanLine[V];
    for H:=0 to Bitmap.Width-1 do
    begin
      a:=Random(Amount)-(Amount shr 1);

      Row.rgbtBlue :=IntToByte(Row.rgbtBlue+a);
      Row.rgbtGreen :=IntToByte(Row.rgbtGreen+a);
      Row.rgbtRed :=IntToByte(Row.rgbtRed+a);
      inc(Row);
    end;
  end;
end;

Color Noise

procedure ColorNoise( Bitmap: TBitmap; Amount: Integer);
var
WSK:^Byte;
H,V,a: Integer;
begin
Bitmap.PixelFormat:=pf24bit;
  for V:=0 to Bitmap.Height-1 do
  begin
    Wsk:=Bitmap.ScanLine[V];
    for H:=0 to Bitmap.Width*3-1 do
    begin
    Wsk^:=IntToByte(Wsk^+(Random(Amount)-(Amount shr 1)));
      inc(Wsk);
    end;
  end;
end;

GrayScale

// description of your code here

Procedure GrayScale(var Bitmap:TBitmap);
var
Row:^TRGBTriple; // wskaźnik do rekordu reprezentującego składowe RGB Pixela
H,V,Index:Integer;
begin
 Bitmap.PixelFormat:=pf24bit;
 for V:=0 to Bitmap.Height-1 do
  begin
    Row:=Bitmap.ScanLine[V];
    for H:=0 to Bitmap.Width -1 do
    begin
    Index := ((Row.rgbtRed * 77 +       //77 to stała dla czerwieni
       Row.rgbtGreen* 150 +           //150 stała dla zielonego
       Row.rgbtBlue * 29) shr 8);    //29  stała dla niebieskiego
       Row.rgbtBlue:=Index;
       Row.rgbtGreen:=Index;
       Row.rgbtRed:=Index;
       inc(Row); { Nie wolno przypisywać X:=0 lub 1,2 bo to Wskaźnk!!!
 poruszamy się inc() lub dec()}

    end;
  end;
end;

Sepia

procedure Sepia ( Bitmap:TBitmap;depth:byte);
var
Row:^TRGBTriple;
H,V:Integer;
begin
 Bitmap.PixelFormat:=pf24bit;
 for V:=0 to Bitmap.Height-1 do
  begin
    Row:=Bitmap.ScanLine[V];
    for H:=0 to Bitmap.Width -1 do
    begin
      Row.rgbtBlue :=(Row.rgbtBlue +Row.rgbtGreen +Row.rgbtRed)div 3;
      Row.rgbtGreen:=Row.rgbtBlue;
      Row.rgbtRed  :=Row.rgbtBlue;
      inc(Row.rgbtRed,depth*2); //dodane wartosci
      inc(Row.rgbtGreen,depth);
      if Row.rgbtRed < (depth*2) then Row.rgbtRed:=255;
      if  Row.rgbtGreen < (depth) then Row.rgbtGreen:=255;
      inc(Row);
    end;
  end;
end;

Blur

Procedure Blur( var Bitmap :TBitmap);
var
TL,TC,TR,BL,BC,BR,LL,LC,LR:^TRGBTriple;
H,V:Integer;
begin
Bitmap.PixelFormat :=pf24bit;
for V := 1 to Bitmap.Height - 2 do
begin
TL:= Bitmap.ScanLine[V - 1];
TC:=TL;    // to samo Scanline  Bitmap.ScanLine[V - 1]; tylko oszczędniej
TR:=TL;
BL:= Bitmap.ScanLine[V];
BC:=BL;
BR:=BL;
LL:= Bitmap.ScanLine[V + 1];
LC:=LL;
LR:=LL;
inc(TC); inc(TR,2);
inc(BC); inc(BR,2);
inc(LC); inc(LR,2);

for H := 1 to (Bitmap.Width  - 2) do
begin
//Wyciągam srednią z 9 sąsiadujących pixeli
  BC.rgbtRed:= (BC.rgbtRed+ BL.rgbtRed+BR.rgbtRed+
  TC.rgbtRed+ TL.rgbtRed+TR.rgbtRed+
  LL.rgbtRed+ LC.rgbtRed+LR.rgbtRed) div 9 ;

  BC.rgbtGreen:=( BC.rgbtGreen+ BL.rgbtGreen+BR.rgbtGreen+
  TC.rgbtGreen+ TL.rgbtGreen+TR.rgbtGreen+
  LL.rgbtGreen+ LC.rgbtGreen+LR.rgbtGreen) div 9 ;

  BC.rgbtBlue:=( BC.rgbtBlue+ BL.rgbtBlue+BR.rgbtBlue+
  TC.rgbtBlue+ TL.rgbtBlue+TR.rgbtBlue+
  LL.rgbtBlue+ LC.rgbtBlue+LR.rgbtBlue )div 9 ;
//zwiększam wskaźniki biorąc następne 9 pixeli
  inc(TL);inc(TC);inc(TR);
  inc(BL);inc(BC);inc(BR);
  inc(LL);inc(LC);inc(LR);
    end;
  end;
end;

Lightness

procedure Lightness( Bitmap:TBitmap; Amount: Integer);
var
Wsk:^Byte;
H,V: Integer;
begin
Bitmap.PixelFormat:=Graphics.pf24bit;
  for V:=0 to Bitmap.Height-1 do
  begin
    Wsk:=Bitmap.ScanLine[V];
    for H:=0 to Bitmap.Width*3-1 do
    begin
    Wsk^:=IntToByte(Wsk^+((255-Wsk^)*Amount)div 255);
    inc(Wsk);
    end;
  end;
end;