Delphi基本图像处理方法汇总

Delphi基本图像处理方法汇总

这篇文章主要介绍了Delphi基本图像处理方法,实例汇总了Delphi操作图像实现浮雕、反色、模糊、翻转等常用效果的方法,非常具有实用价值,需要的朋友可以参考下

 

本文实例汇总了Delphi基本图像处理方法。分享给大家供大家参考。具体分析如下：

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783

//浮雕 procedure Emboss(SrcBmp,DestBmp:TBitmap;AzimuthChange:integer);overload; var  i, j, Gray, Azimuthvalue, R, G, B: integer;  SrcRGB, SrcRGB1, SrcRGB2, DestRGB: pRGBTriple; begin  for i := 0 to SrcBmp.Height - 1 do  begin   SrcRGB := SrcBmp.ScanLine[i];   DestRGB := DestBmp.ScanLine[i];   if (AzimuthChange >= -180) and (AzimuthChange < -135) then   begin    if i > 0 then     SrcRGB1 := SrcBmp.ScanLine[i-1]    else     SrcRGB1 := SrcRGB;    Inc(SrcRGB1);    SrcRGB2 := SrcRGB;    Inc(SrcRGB2);   end   else if (AzimuthChange >= -135) and (AzimuthChange < -90) then   begin    if i > 0 then     SrcRGB1 := SrcBmp.ScanLine[i-1]    else     SrcRGB1 := SrcRGB;    SrcRGB2 := SrcRGB1;    Inc(SrcRGB2);   end   else if (AzimuthChange >= -90) and (AzimuthChange < -45) then   begin    if i > 0 then     SrcRGB1 := SrcBmp.ScanLine[i-1]    else     SrcRGB1 := SrcRGB;    SrcRGB2 := SrcRGB1;   end   else if (AzimuthChange >= -45) and (AzimuthChange < 0) then   begin    SrcRGB1 := SrcRGB;    if i > 0 then     SrcRGB2 := SrcBmp.ScanLine[i-1]    else     SrcRGB2 := SrcRGB;   end   else if (AzimuthChange >= 0) and (AzimuthChange < 45) then   begin    SrcRGB2 := SrcRGB;    if (i < SrcBmp.Height - 1) then     SrcRGB1 := SrcBmp.ScanLine[i+1]    else     SrcRGB1 := SrcRGB;   end   else if (AzimuthChange >= 45) and (AzimuthChange < 90) then   begin    if (i < SrcBmp.Height - 1) then     SrcRGB1 := SrcBmp.ScanLine[i+1]    else     SrcRGB1 := SrcRGB;    SrcRGB2 := SrcRGB1;   end   else if (AzimuthChange >= 90) and (AzimuthChange < 135) then   begin    if (i < SrcBmp.Height - 1) then     SrcRGB1 := SrcBmp.ScanLine[i+1]    else     SrcRGB1 := SrcRGB;    SrcRGB2 := SrcRGB1;    Inc(SrcRGB1);   end   else if (AzimuthChange >= 135) and (AzimuthChange <= 180) then   begin    if (i < SrcBmp.Height - 1) then     SrcRGB2 := SrcBmp.ScanLine[i+1]    else     SrcRGB2 := SrcRGB;    Inc(SrcRGB2);    SrcRGB1 := SrcRGB;    Inc(SrcRGB1);   end;   for j := 0 to SrcBmp.Width - 1 do   begin    if (AzimuthChange >= -180) and (AzimuthChange < -135) then    begin     Azimuthvalue := AzimuthChange + 180;     R:=SrcRGB.rgbtRed-((SrcRGB1.rgbtRed)*Azimuthvalue div 45)-((SrcRGB2.rgbtRed)*(45-Azimuthvalue) div 45)+78;     G:=SrcRGB.rgbtGreen-((SrcRGB1.rgbtGreen)*Azimuthvalue div 45)-((SrcRGB2.rgbtGreen)*(45-Azimuthvalue) div 45)+78;     B:=SrcRGB.rgbtBlue-((SrcRGB1.rgbtBlue)*Azimuthvalue div 45)-((SrcRGB2.rgbtBlue)*(45-Azimuthvalue) div 45)+78;    end    else if (AzimuthChange >= -135) and (AzimuthChange < -90) then    begin     Azimuthvalue := AzimuthChange + 135;     R:=SrcRGB.rgbtRed-((SrcRGB1.rgbtRed)*Azimuthvalue div 45)-((SrcRGB2.rgbtRed)*(45-Azimuthvalue) div 45)+78;     G:=SrcRGB.rgbtGreen-((SrcRGB1.rgbtGreen)*Azimuthvalue div 45)-((SrcRGB2.rgbtGreen)*(45-Azimuthvalue) div 45)+78;     B:=SrcRGB.rgbtBlue-((SrcRGB1.rgbtBlue)*Azimuthvalue div 45)-((SrcRGB2.rgbtBlue)*(45-Azimuthvalue) div 45)+78;    end    else if (AzimuthChange >= -90) and (AzimuthChange < -45) then    begin     if j=1 then Inc(SrcRGB1,-1);     Azimuthvalue := AzimuthChange + 90;     R:=SrcRGB.rgbtRed-((SrcRGB1.rgbtRed)*Azimuthvalue div 45)-((SrcRGB2.rgbtRed)*(45-Azimuthvalue) div 45)+78;     G:=SrcRGB.rgbtGreen-((SrcRGB1.rgbtGreen)*Azimuthvalue div 45)-((SrcRGB2.rgbtGreen)*(45-Azimuthvalue) div 45)+78;     B:=SrcRGB.rgbtBlue-((SrcRGB1.rgbtBlue)*Azimuthvalue div 45)-((SrcRGB2.rgbtBlue)*(45-Azimuthvalue) div 45)+78;    end    else if (AzimuthChange >= -45) and (AzimuthChange < 0) then    begin     if j=1 then     begin      Inc(SrcRGB1,-1);      Inc(SrcRGB2,-1);     end;     Azimuthvalue := AzimuthChange + 45;     R:=SrcRGB.rgbtRed-((SrcRGB1.rgbtRed)*Azimuthvalue div 45)-((SrcRGB2.rgbtRed)*(45-Azimuthvalue) div 45)+78;     G:=SrcRGB.rgbtGreen-((SrcRGB1.rgbtGreen)*Azimuthvalue div 45)-((SrcRGB2.rgbtGreen)*(45-Azimuthvalue) div 45)+78;     B:=SrcRGB.rgbtBlue-((SrcRGB1.rgbtBlue)*Azimuthvalue div 45)-((SrcRGB2.rgbtBlue)*(45-Azimuthvalue) div 45)+78;    end    else if (AzimuthChange >= 0) and (AzimuthChange < 45) then    begin     if j=1 then     begin      Inc(SrcRGB1,-1);      Inc(SrcRGB2,-1);     end;     Azimuthvalue := AzimuthChange;     R:=SrcRGB.rgbtRed-((SrcRGB1.rgbtRed)*Azimuthvalue div 45)-((SrcRGB2.rgbtRed)*(45-Azimuthvalue) div 45)+78;     G:=SrcRGB.rgbtGreen-((SrcRGB1.rgbtGreen)*Azimuthvalue div 45)-((SrcRGB2.rgbtGreen)*(45-Azimuthvalue) div 45)+78;     B:=SrcRGB.rgbtBlue-((SrcRGB1.rgbtBlue)*Azimuthvalue div 45)-((SrcRGB2.rgbtBlue)*(45-Azimuthvalue) div 45)+78;    end    else if (AzimuthChange >= 45) and (AzimuthChange < 90) then    begin     if j=1 then Inc(SrcRGB2,-1);     Azimuthvalue := AzimuthChange - 45;     R:=SrcRGB.rgbtRed-((SrcRGB1.rgbtRed)*Azimuthvalue div 45)-((SrcRGB2.rgbtRed)*(45-Azimuthvalue) div 45)+78;     G:=SrcRGB.rgbtGreen-((SrcRGB1.rgbtGreen)*Azimuthvalue div 45)-((SrcRGB2.rgbtGreen)*(45-Azimuthvalue) div 45)+78;     B:=SrcRGB.rgbtBlue-((SrcRGB1.rgbtBlue)*Azimuthvalue div 45)-((SrcRGB2.rgbtBlue)*(45-Azimuthvalue) div 45)+78;    end    else if (AzimuthChange >= 90) and (AzimuthChange < 135) then    begin     Azimuthvalue := AzimuthChange - 90;     R:=SrcRGB.rgbtRed-((SrcRGB1.rgbtRed)*Azimuthvalue div 45)-((SrcRGB2.rgbtRed)*(45-Azimuthvalue) div 45)+78;     G:=SrcRGB.rgbtGreen-((SrcRGB1.rgbtGreen)*Azimuthvalue div 45)-((SrcRGB2.rgbtGreen)*(45-Azimuthvalue) div 45)+78;     B:=SrcRGB.rgbtBlue-((SrcRGB1.rgbtBlue)*Azimuthvalue div 45)-((SrcRGB2.rgbtBlue)*(45-Azimuthvalue) div 45)+78;    end    else if (AzimuthChange >= 135) and (AzimuthChange <= 180) then    begin     Azimuthvalue := AzimuthChange - 135;     R:=SrcRGB.rgbtRed-((SrcRGB1.rgbtRed)*Azimuthvalue div 45)-((SrcRGB2.rgbtRed)*(45-Azimuthvalue) div 45)+78;     G:=SrcRGB.rgbtGreen-((SrcRGB1.rgbtGreen)*Azimuthvalue div 45)-((SrcRGB2.rgbtGreen)*(45-Azimuthvalue) div 45)+78;     B:=SrcRGB.rgbtBlue-((SrcRGB1.rgbtBlue)*Azimuthvalue div 45)-((SrcRGB2.rgbtBlue)*(45-Azimuthvalue) div 45)+78;    end;    R:=Min(R,255);    R:=Max(R,0);    G:=Min(G,255);    G:=Max(G,0);    B:=Min(B,255);    B:=Max(B,0);    Gray := (R shr 2) + (R shr 4) + (G shr 1) + (G shr 4) + (B shr 3);    DestRGB.rgbtRed:=Gray;    DestRGB.rgbtGreen:=Gray;    DestRGB.rgbtBlue:=Gray;    if (j=-180) and (AzimuthChange<-135)) or ((AzimuthChange>=90) and (AzimuthChange<=180))) then    begin     Inc(SrcRGB1);    end;    if (j=135) and (AzimuthChange<180)) or ((AzimuthChange>=-180) and (AzimuthChange<=-90))) then    begin     Inc(SrcRGB2);    end;    Inc(SrcRGB);    Inc(DestRGB);   end;  end; end; procedure Emboss(Bmp:TBitmap;AzimuthChange:integer;ElevationChange:integer;WeightChange:integer);overload; var  DestBmp:TBitmap; begin 　　DestBmp:=TBitmap.Create; 　　DestBmp.Assign(Bmp); 　　Emboss(Bmp,DestBmp,AzimuthChange,ElevationChange,WeightChange); 　　Bmp.Assign(DestBmp); end; //反色 procedure Negative(Bmp:TBitmap); var  i, j: Integer;  PRGB: pRGBTriple; begin  Bmp.PixelFormat:=pf24Bit;  for i := 0 to Bmp.Height - 1 do  begin   PRGB := Bmp.ScanLine[i];   for j := 0 to Bmp.Width - 1 do   begin    PRGB^.rgbtRed :=not PRGB^.rgbtRed ;    PRGB^.rgbtGreen :=not PRGB^.rgbtGreen;    PRGB^.rgbtBlue :=not PRGB^.rgbtBlue;    Inc(PRGB);   end;  end; end; //曝光 procedure Exposure(Bmp:TBitmap); var  i, j: integer;  PRGB: pRGBTriple; begin  Bmp.PixelFormat:=pf24Bit;  for i := 0 to Bmp.Height - 1 do  begin   PRGB := Bmp.ScanLine[i];   for j := 0 to Bmp.Width - 1 do   begin    if PRGB^.rgbtRed<128 then     PRGB^.rgbtRed :=not PRGB^.rgbtRed ;    if PRGB^.rgbtGreen<128 then     PRGB^.rgbtGreen :=not PRGB^.rgbtGreen;    if PRGB^.rgbtBlue<128 then     PRGB^.rgbtBlue :=not PRGB^.rgbtBlue;    Inc(PRGB);   end;  end; end; //模糊 procedure Blur(SrcBmp:TBitmap); var  i, j:Integer;  SrcRGB:pRGBTriple;  SrcNextRGB:pRGBTriple;  SrcPreRGB:pRGBTriple;  Value:Integer;  procedure IncRGB;  begin   Inc(SrcPreRGB);   Inc(SrcRGB);   Inc(SrcNextRGB);  end;  procedure DecRGB;  begin   Inc(SrcPreRGB,-1);   Inc(SrcRGB,-1);   Inc(SrcNextRGB,-1);  end; begin  SrcBmp.PixelFormat:=pf24Bit;  for i := 0 to SrcBmp.Height - 1 do  begin   if i > 0 then    SrcPreRGB:=SrcBmp.ScanLine[i-1]   else    SrcPreRGB := SrcBmp.ScanLine[i];   SrcRGB := SrcBmp.ScanLine[i];   if i < SrcBmp.Height - 1 then    SrcNextRGB:=SrcBmp.ScanLine[i+1]   else    SrcNextRGB:=SrcBmp.ScanLine[i];   for j := 0 to SrcBmp.Width - 1 do   begin    if j > 0 then DecRGB;    Value:=SrcPreRGB.rgbtRed+SrcRGB.rgbtRed+SrcNextRGB.rgbtRed;    if j > 0 then IncRGB;    Value:=Value+SrcPreRGB.rgbtRed+SrcRGB.rgbtRed+SrcNextRGB.rgbtRed;    if j < SrcBmp.Width - 1 then IncRGB;    Value:=(Value+SrcPreRGB.rgbtRed+SrcRGB.rgbtRed+SrcNextRGB.rgbtRed) div 9;    DecRGB;    SrcRGB.rgbtRed:=value;    if j > 0 then DecRGB;    Value:=SrcPreRGB.rgbtGreen+SrcRGB.rgbtGreen+SrcNextRGB.rgbtGreen;    if j > 0 then IncRGB;    Value:=Value+SrcPreRGB.rgbtGreen+SrcRGB.rgbtGreen+SrcNextRGB.rgbtGreen;    if j < SrcBmp.Width - 1 then IncRGB;    Value:=(Value+SrcPreRGB.rgbtGreen+SrcRGB.rgbtGreen+SrcNextRGB.rgbtGreen) div 9;    DecRGB;    SrcRGB.rgbtGreen:=value;    if j > 0 then DecRGB;    Value:=SrcPreRGB.rgbtBlue+SrcRGB.rgbtBlue+SrcNextRGB.rgbtBlue;    if j > 0 then IncRGB;    Value:=Value+SrcPreRGB.rgbtBlue+SrcRGB.rgbtBlue+SrcNextRGB.rgbtBlue;    if j < SrcBmp.Width - 1 then IncRGB;    Value:=(Value+SrcPreRGB.rgbtBlue+SrcRGB.rgbtBlue+SrcNextRGB.rgbtBlue) div 9;    DecRGB;    SrcRGB.rgbtBlue:=value;    IncRGB;   end;  end; end; //锐化 procedure Sharpen(SrcBmp:TBitmap); var  i, j: integer;  SrcRGB: pRGBTriple;  SrcPreRGB: pRGBTriple;  Value: integer; begin  SrcBmp.PixelFormat:=pf24Bit;  for i := 0 to SrcBmp.Height - 1 do  begin   SrcRGB := SrcBmp.ScanLine[i];   if i > 0 then    SrcPreRGB:=SrcBmp.ScanLine[i-1]   else    SrcPreRGB:=SrcBmp.ScanLine[i];   for j := 0 to SrcBmp.Width - 1 do   begin    if j = 1 then Dec(SrcPreRGB);    Value:=SrcRGB.rgbtRed+(SrcRGB.rgbtRed-SrcPreRGB.rgbtRed) div 2;    Value:=Max(0,Value);    Value:=Min(255,Value);    SrcRGB.rgbtRed:=value;    Value:=SrcRGB.rgbtGreen+(SrcRGB.rgbtGreen-SrcPreRGB.rgbtGreen) div 2;    Value:=Max(0,Value);    Value:=Min(255,Value);    SrcRGB.rgbtGreen:=value;    Value:=SrcRGB.rgbtBlue+(SrcRGB.rgbtBlue-SrcPreRGB.rgbtBlue) div 2;    Value:=Max(0,Value);    Value:=Min(255,Value);    SrcRGB.rgbtBlue:=value;    Inc(SrcRGB);    Inc(SrcPreRGB);   end;  end; end;  [图像的旋转和翻转] 以下代码用ScanLine配合指针移动实现，用于24位色！ //旋转90度 procedure Rotate90(const Bitmap:TBitmap); var  i,j:Integer;  rowIn,rowOut:pRGBTriple;  Bmp:TBitmap;  Width,Height:Integer; begin  Bmp:=TBitmap.Create;  Bmp.Width := Bitmap.Height;  Bmp.Height := Bitmap.Width;  Bmp.PixelFormat := pf24bit;  Width:=Bitmap.Width-1;  Height:=Bitmap.Height-1;  for j := 0 to Height do  begin   rowIn := Bitmap.ScanLine[j];   for i := 0 to Width do   begin    rowOut := Bmp.ScanLine[i];    Inc(rowOut,Height - j);    rowOut^ := rowIn^;    Inc(rowIn);   end;  end;  Bitmap.Assign(Bmp); end; //旋转180度 procedure Rotate180(const Bitmap:TBitmap); var  i,j:Integer;  rowIn,rowOut:pRGBTriple;  Bmp:TBitmap;  Width,Height:Integer; begin  Bmp:=TBitmap.Create;  Bmp.Width := Bitmap.Width;  Bmp.Height := Bitmap.Height;  Bmp.PixelFormat := pf24bit;  Width:=Bitmap.Width-1;  Height:=Bitmap.Height-1;  for j := 0 to Height do  begin   rowIn := Bitmap.ScanLine[j];   for i := 0 to Width do   begin    rowOut := Bmp.ScanLine[Height - j];    Inc(rowOut,Width - i);    rowOut^ := rowIn^;    Inc(rowIn);   end;  end;  Bitmap.Assign(Bmp); end; //旋转270度 procedure Rotate270(const Bitmap:TBitmap); var  i,j:Integer;  rowIn,rowOut:pRGBTriple;  Bmp:TBitmap;  Width,Height:Integer; begin  Bmp:=TBitmap.Create;  Bmp.Width := Bitmap.Height;  Bmp.Height := Bitmap.Width;  Bmp.PixelFormat := pf24bit;  Width:=Bitmap.Width-1;  Height:=Bitmap.Height-1;  for j := 0 to Height do  begin   rowIn := Bitmap.ScanLine[j];   for i := 0 to Width do   begin    rowOut := Bmp.ScanLine[Width - i];    Inc(rowOut,j);    rowOut^ := rowIn^;    Inc(rowIn);   end;  end;  Bitmap.Assign(Bmp); end; //任意角度 function RotateBitmap(Bitmap:TBitmap;Angle:Integer;BackColor:TColor):TBitmap; var  i,j,iOriginal,jOriginal,CosPoint,SinPoint : integer;  RowOriginal,RowRotated : pRGBTriple;  SinTheta,CosTheta : Extended;  AngleAdd : integer; begin  Result:=TBitmap.Create;  Result.PixelFormat := pf24bit;  Result.Canvas.Brush.Color:=BackColor;  Angle:=Angle Mod 360;  if Angle<0 then Angle:=360-Abs(Angle);  if Angle=0 then   Result.Assign(Bitmap)  else if Angle=90 then  begin   Result.Assign(Bitmap);   Rotate90(Result);//如果是旋转90度，直接调用上面的代码  end  else if (Angle>90) and (Angle<180) then  begin   AngleAdd:=90;   Angle:=Angle-AngleAdd;  end  else if Angle=180 then  begin   Result.Assign(Bitmap);   Rotate180(Result);//如果是旋转180度，直接调用上面的过程  end  else if (Angle>180) and (Angle<270) then  begin   AngleAdd:=180;   Angle:=Angle-AngleAdd;  end  else if Angle=270 then  begin   Result.Assign(Bitmap);   Rotate270(Result);//如果是旋转270度，直接调用上面的过程  end  else if (Angle>270) and (Angle<360) then  begin   AngleAdd:=270;   Angle:=Angle-AngleAdd;  end  else   AngleAdd:=0;  if (Angle>0) and (Angle<90) then  begin  SinCos((Angle + AngleAdd) * Pi / 180, SinTheta, CosTheta);  if (SinTheta * CosTheta) < 0 then  begin   Result.Width := Round(Abs(Bitmap.Width * CosTheta - Bitmap.Height * SinTheta));   Result.Height := Round(Abs(Bitmap.Width * SinTheta - Bitmap.Height * CosTheta));  end  else  begin   Result.Width := Round(Abs(Bitmap.Width * CosTheta + Bitmap.Height * SinTheta));   Result.Height := Round(Abs(Bitmap.Width * SinTheta + Bitmap.Height * CosTheta));  end;  CosTheta:=Abs(CosTheta);  SinTheta:=Abs(SinTheta);  if (AngleAdd=0) or (AngleAdd=180) then  begin   CosPoint:=Round(Bitmap.Height*CosTheta);   SinPoint:=Round(Bitmap.Height*SinTheta);  end  else  begin   SinPoint:=Round(Bitmap.Width*CosTheta);   CosPoint:=Round(Bitmap.Width*SinTheta);  end;  for j := 0 to Result.Height-1 do  begin   RowRotated := Result.Scanline[j];   for i := 0 to Result.Width-1 do   begin    Case AngleAdd of     0:     begin      jOriginal := Round((j+1)*CosTheta-(i+1-SinPoint)*SinTheta)-1;      iOriginal := Round((i+1)*CosTheta-(CosPoint-j-1)*SinTheta)-1;     end;     90:     begin      iOriginal := Round((j+1)*SinTheta-(i+1-SinPoint)*CosTheta)-1;      jOriginal := Bitmap.Height-Round((i+1)*SinTheta-(CosPoint-j-1)*CosTheta);     end;     180:     begin      jOriginal := Bitmap.Height-Round((j+1)*CosTheta-(i+1-SinPoint)*SinTheta);      iOriginal := Bitmap.Width-Round((i+1)*CosTheta-(CosPoint-j-1)*SinTheta);     end;     270:     begin      iOriginal := Bitmap.Width-Round((j+1)*SinTheta-(i+1-SinPoint)*CosTheta);      jOriginal := Round((i+1)*SinTheta-(CosPoint-j-1)*CosTheta)-1;     end;    end;    if (iOriginal >= 0) and (iOriginal <= Bitmap.Width-1)and      (jOriginal >= 0) and (jOriginal <= Bitmap.Height-1)    then    begin     RowOriginal := Bitmap.Scanline[jOriginal];     Inc(RowOriginal,iOriginal);     RowRotated^ := RowOriginal^;     Inc(RowRotated);    end    else    begin     Inc(RowRotated);    end;   end;  end;  end; end; //水平翻转 procedure FlipHorz(const Bitmap:TBitmap); var  i,j:Integer;  rowIn,rowOut:pRGBTriple;  Bmp:TBitmap;  Width,Height:Integer; begin  Bmp:=TBitmap.Create;  Bmp.Width := Bitmap.Width;  Bmp.Height := Bitmap.Height;  Bmp.PixelFormat := pf24bit;  Width:=Bitmap.Width-1;  Height:=Bitmap.Height-1;  for j := 0 to Height do  begin   rowIn := Bitmap.ScanLine[j];   for i := 0 to Width do   begin    rowOut := Bmp.ScanLine[j];    Inc(rowOut,Width - i);    rowOut^ := rowIn^;    Inc(rowIn);   end;  end;  Bitmap.Assign(Bmp); end; //垂直翻转 procedure FlipVert(const Bitmap:TBitmap); var  i,j:Integer;  rowIn,rowOut:pRGBTriple;  Bmp:TBitmap;  Width,Height:Integer; begin  Bmp:=TBitmap.Create;  Bmp.Width := Bitmap.Height;  Bmp.Height := Bitmap.Width;  Bmp.PixelFormat := pf24bit;  Width:=Bitmap.Width-1;  Height:=Bitmap.Height-1;  for j := 0 to Height do  begin   rowIn := Bitmap.ScanLine[j];   for i := 0 to Width do   begin    rowOut := Bmp.ScanLine[Height - j];    Inc(rowOut,i);    rowOut^ := rowIn^;    Inc(rowIn);   end;  end;  Bitmap.Assign(Bmp); end; [亮度、对比度、饱和度的调整] 以下代码用ScanLine配合指针移动实现！ function Min(a, b: integer): integer; begin  if a < b then   result := a  else   result := b; end; function Max(a, b: integer): integer; begin  if a > b then   result := a  else   result := b; end; //亮度调整 procedure BrightnessChange(const SrcBmp,DestBmp:TBitmap;ValueChange:integer); var  i, j: integer;  SrcRGB, DestRGB: pRGBTriple; begin  for i := 0 to SrcBmp.Height - 1 do  begin   SrcRGB := SrcBmp.ScanLine[i];   DestRGB := DestBmp.ScanLine[i];   for j := 0 to SrcBmp.Width - 1 do   begin    if ValueChange > 0 then    begin     DestRGB.rgbtRed := Min(255, SrcRGB.rgbtRed + ValueChange);     DestRGB.rgbtGreen := Min(255, SrcRGB.rgbtGreen + ValueChange);     DestRGB.rgbtBlue := Min(255, SrcRGB.rgbtBlue + ValueChange);    end else begin     DestRGB.rgbtRed := Max(0, SrcRGB.rgbtRed + ValueChange);     DestRGB.rgbtGreen := Max(0, SrcRGB.rgbtGreen + ValueChange);     DestRGB.rgbtBlue := Max(0, SrcRGB.rgbtBlue + ValueChange);    end;    Inc(SrcRGB);    Inc(DestRGB);   end;  end; end; //对比度调整 procedure ContrastChange(const SrcBmp,DestBmp:TBitmap;ValueChange:integer); var  i, j: integer;  SrcRGB, DestRGB: pRGBTriple; begin  for i := 0 to SrcBmp.Height - 1 do  begin   SrcRGB := SrcBmp.ScanLine[i];   DestRGB := DestBmp.ScanLine[i];   for j := 0 to SrcBmp.Width - 1 do   begin    if ValueChange>=0 then    begin    if SrcRGB.rgbtRed >= 128 then     DestRGB.rgbtRed := Min(255, SrcRGB.rgbtRed + ValueChange)    else     DestRGB.rgbtRed := Max(0, SrcRGB.rgbtRed - ValueChange);    if SrcRGB.rgbtGreen >= 128 then     DestRGB.rgbtGreen := Min(255, SrcRGB.rgbtGreen + ValueChange)    else     DestRGB.rgbtGreen := Max(0, SrcRGB.rgbtGreen - ValueChange);    if SrcRGB.rgbtBlue >= 128 then     DestRGB.rgbtBlue := Min(255, SrcRGB.rgbtBlue + ValueChange)    else     DestRGB.rgbtBlue := Max(0, SrcRGB.rgbtBlue - ValueChange);    end    else    begin    if SrcRGB.rgbtRed >= 128 then     DestRGB.rgbtRed := Max(128, SrcRGB.rgbtRed + ValueChange)    else     DestRGB.rgbtRed := Min(128, SrcRGB.rgbtRed - ValueChange);    if SrcRGB.rgbtGreen >= 128 then     DestRGB.rgbtGreen := Max(128, SrcRGB.rgbtGreen + ValueChange)    else     DestRGB.rgbtGreen := Min(128, SrcRGB.rgbtGreen - ValueChange);    if SrcRGB.rgbtBlue >= 128 then     DestRGB.rgbtBlue := Max(128, SrcRGB.rgbtBlue + ValueChange)    else     DestRGB.rgbtBlue := Min(128, SrcRGB.rgbtBlue - ValueChange);    end;    Inc(SrcRGB);    Inc(DestRGB);   end;  end; end; //饱和度调整 procedure SaturationChange(const SrcBmp,DestBmp:TBitmap;ValueChange:integer); var  Grays: array[0..767] of Integer;  Alpha: array[0..255] of Word;  Gray, x, y: Integer;  SrcRGB,DestRGB: pRGBTriple;  i: Byte; begin ValueChange:=ValueChange+255; for i := 0 to 255 do  Alpha[i] := (i * ValueChange) Shr 8; x := 0; for i := 0 to 255 do begin  Gray := i - Alpha[i];  Grays[x] := Gray;  Inc(x);  Grays[x] := Gray;  Inc(x);  Grays[x] := Gray;  Inc(x); end; for y := 0 to SrcBmp.Height - 1 do begin  SrcRGB := SrcBmp.ScanLine[Y];  DestRGB := DestBmp.ScanLine[Y];  for x := 0 to SrcBmp.Width - 1 do  begin   Gray := Grays[SrcRGB.rgbtRed + SrcRGB.rgbtGreen + SrcRGB.rgbtBlue];   if Gray + Alpha[SrcRGB.rgbtRed]>0 then    DestRGB.rgbtRed := Min(255,Gray + Alpha[SrcRGB.rgbtRed])   else    DestRGB.rgbtRed := 0;   if Gray + Alpha[SrcRGB.rgbtGreen]>0 then    DestRGB.rgbtGreen := Min(255,Gray + Alpha[SrcRGB.rgbtGreen])   else    DestRGB.rgbtGreen := 0;   if Gray + Alpha[SrcRGB.rgbtBlue]>0 then    DestRGB.rgbtBlue := Min(255,Gray + Alpha[SrcRGB.rgbtBlue])   else    DestRGB.rgbtBlue := 0;   Inc(SrcRGB);   Inc(DestRGB);  end; end; end; //RGB调整 procedure RGBChange(SrcBmp,DestBmp:TBitmap;RedChange,GreenChange,BlueChange:integer); var  SrcRGB, DestRGB: pRGBTriple;  i,j:integer; begin  for i := 0 to SrcBmp.Height- 1 do  begin   SrcRGB := SrcBmp.ScanLine[i];   DestRGB :=DestBmp.ScanLine[i];   for j := 0 to SrcBmp.Width - 1 do   begin    if RedChange> 0 then     DestRGB.rgbtRed := Min(255, SrcRGB.rgbtRed + RedChange)    else     DestRGB.rgbtRed := Max(0, SrcRGB.rgbtRed + RedChange);    if GreenChange> 0 then     DestRGB.rgbtGreen := Min(255, SrcRGB.rgbtGreen + GreenChange)    else     DestRGB.rgbtGreen := Max(0, SrcRGB.rgbtGreen + GreenChange);    if BlueChange> 0 then     DestRGB.rgbtBlue := Min(255, SrcRGB.rgbtBlue + BlueChange)    else     DestRGB.rgbtBlue := Max(0, SrcRGB.rgbtBlue + BlueChange);    Inc(SrcRGB);    Inc(DestRGB);   end;  end; end; [颜色调整] //RGB<=>BGR procedure RGB2BGR(const Bitmap:TBitmap); var  X: Integer;  Y: Integer;  PRGB: pRGBTriple;  Color: Byte; begin  for Y := 0 to (Bitmap.Height - 1) do  begin   for X := 0 to (Bitmap.Width - 1) do   begin    Color := PRGB^.rgbtRed;    PRGB^.rgbtRed := PRGB^.rgbtBlue;    PRGB^.rgbtBlue := Color;    Inc(PRGB);   end;   end  end; end; //灰度化(加权) procedure Grayscale(const Bitmap:TBitmap); var  X: Integer;  Y: Integer;  PRGB: pRGBTriple;  Gray: Byte; begin  for Y := 0 to (Bitmap.Height - 1) do  begin   PRGB := Bitmap.ScanLine[Y];   for X := 0 to (Bitmap.Width - 1) do   begin    Gray := (77 * Red + 151 * Green + 28 * Blue) shr 8;    PRGB^.rgbtRed:=Gray;    PRGB^.rgbtGreen:=Gray;    PRGB^.rgbtBlue:=Gray;    Inc(PRGB);   end;  end; end;

理论篇：

关键词：

绘图区－即窗口显示图像的区域，亦可为全屏幕（在全屏幕下绘图的效果比一般窗口下好）
中心点－即要绘图区显示的中心点在原始图像的坐标（声明：这个概念特别重要）

先说说图像的放大，要放大一张图片，我们一般的做法是直接放大图像，但本文介绍的方法仅放大我们能够看到的部分，放大分两种情况，一种是放大后比绘图区还要小，这种情况没什么好说，当然是显示全部的图像；第二种是放大后的图像比绘图区大，这才是我们今天要讨论的重点话题，这种情况下我们先要确定图像放大后的大小，然后根据“中心点”计算在原始图像的位置和大小，最后把截取的图像放大到绘图区。

再说说图像的漫游，当显示的图像超过绘图区时，我们需要对图像进行漫游，以便看到全部的图像。原理是：当鼠标在绘图区进行单击时，这时开始漫游，先记录鼠标的单击位置，然后检测鼠标的移动，根据鼠标和上次的位移计算出“中心点”（需要将屏幕坐标转换为原始图像坐标），根据在上面放大的原理到原始图像中取出要显示的部分，放大显示到绘图区。

算法实现篇：

1.图像放大
变量定义：
PZoom:放大率(整数:100时为100%，根据需要可以将 100 该为 10000 或者更大些，但不推荐使用浮点数)
a,b:中心点
w,h:要截取原始图像的宽和高
x,y:要截取的位置(左上角)
sw,sh:原始图像的宽和高
p1,p2:放大比例
aw,ah:放大后图像的大小
pw,ph:绘图区大小
vx,vy:在绘图区显示的位置（左上角）
vw,vh:在绘图区显示的大小
ptx,pty:临时变量
已知的变量：PZoom,(a,b),(sw,sh),(p1,p2),(aw,ah),(pw,ph)
要计算的变量：(x,y),(w,h),(vx,vy),(vw,vh)
开始计算：

?

1 2 3 4 5 6 7 8 9 10 11 12 13 14

aw=Round(PZoom*sw/100); ah=Round(PZoom*sh/100); p1=aw/pw p2=ah/ph // 注：Round 用于取整，如其他语言的Int(),Fix()等 if p1>1 then w=Round(sw/p1) else w=sw if p2>1 then h=Round(sh/p2) else h=sh // 注：shr 为右移运算符，可以使用“>>1”、“div 2”、“/2”或“Round(w/2)”代替 x=a-w shr 1 y=b-h shr 1 // 注：div 为整除运算符 ptx=(w*PZoom) div 100 pty=(h*PZoom) div 100 // 以下计算在绘图区显示的图像大小和位置

变量

?

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15

Pencent:double; // 缩放比   wx:double;    // 宽缩放比   hx:double;    // 高缩放比   // 获得缩放比   wx:=pw/ptx   hx:=ph/pty   if wx>hx then Pencent:=hx   else     Pencent:=wx;   // 获得图片最后的大小   vw:=Round(Pencent*ptx);   vh:=Round(Pencent*pty);   // 计算出图片的位置   vx:=(pw-vw) div 2;   vy:=(ph-vh) div 2; // ------------------------------------

好了，两个重要的任务完成(x,y),(w,h),(vx,vy),(vw,vh)已经全部计算得出，下面的工作就是显示了，我们选择 Windows API 进行操作
变量

?

1 2 3 4 5 6

sDC 为原始图片的设备句柄(DC) tDC 为临时设备句柄 dDC 最终设备句柄 BitBlt(tDC,0,0,w,h,sDC,0,0,SRCCOPY); SetStretchBltMode(dDC,STRETCH_DELETESCANS); StretchBlt(dDC,0,0,vw,vh,tDC,0,0,w,h,SRCCOPY);

最后绘制到显示的区域即可：
例如：

?

1	BitBlt(GetDC(0),vx,vy,vx+vw,xy+vh,dDC,0,0,SRCCOPY);

2.图像漫游

先定义三个全局变量：

?

1 2 3 4

FBeginDragPoint  :TPoint;     // 记录鼠标开始拖动的位置 FBeginDragSBPoint :TPoint;     // 记录“中心点”位置 FBeginDrag    :boolean;    // 是否已经开始“拖动” a,b        :integer;    // “中心点”位置

在鼠标左键点击时，记录鼠标的位置和“中心点”的位置，同时设置 FBeginDrag 为真
当鼠标右键弹起时，设置 FBeginDrag 为假
鼠标移动时，判断 FBeginDrag ，如果为假不进行处理，如果为真进行下面处理：
假设 X,Y 为鼠标当前的位置

?

1 2	a=FBeginDragPoint.X-((X-FBeginDragPoint.X)*100) div PZoom b=FBeginDragPoint.Y-((Y-FBeginDragPoint.Y)*100) div PZoom

最后使用上面介绍的图像放大显示出图像

技巧篇：

1.如果图像较大，使用 delphi 的 位图对象会出现内存溢出错误，这时可以进行如下设置：

?

1 2 3

bitImage:=TBitmap.Create; bitImage.PixelFormat:=pf24bit; bitImage.ReleaseHandle;

2.如果要让图像自动适应窗口的大小，参考以下代码：

?

1 2 3 4 5 6 7 8 9

var   p1,p2    :double; begin   p1:=pw/sw;   p2:=ph/sw;   if p1>p2 then PZoom:=Round(p2*100)   else     PZoom:=Round(p1*100);   if PZoom=0 then PZoom:=100; end;

Delphi灰度图像像素颜色亮度处理

在图像处理中，速度是很重要的。因此，我们得重新处理一下TBitmap,得到TVczhBitmap。这只是因为GetPixels和SetPixels的速度太慢，换一个方法而已。

?

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70

unit untBitmapProc; interface uses Graphics, SysUtils; type TVczhBitmap=class(TBitmap) private Data:PByteArray; Line:Integer; procedure SetFormat; function GetBytePointer(X,Y:Integer):PByte; procedure SetBytes(X,Y:Integer;Value:Byte); function GetBytes(X,Y:Integer):Byte; protected published constructor Create; public property Bytes[X,Y:Integer]:Byte read GetBytes write SetBytes; procedure LoadFromFile(FileName:String); procedure ToGray; end; implementation procedure TVczhBitmap.SetFormat; begin HandleType:=bmDIB; PixelFormat:=pf24bit; end; function TVczhBitmap.GetBytePointer(X,Y:Integer):PByte; begin if Line<>Y then begin Line:=Y; Data:=ScanLine[Y]; end; Longint(result):=Longint(Data)+X; end; procedure TVczhBitmap.SetBytes(X,Y:Integer;Value:Byte); begin GetBytePointer(X,Y)^:=Value; end; function TVczhBitmap.GetBytes(X,Y:Integer):Byte; begin result:=GetBytePointer(X,Y)^; end; constructor TVczhBitmap.Create; begin inherited Create; SetFormat; Line:=-1; end; procedure TVczhBitmap.LoadFromFile(FileName:String); begin inherited LoadFromFile(FileName); SetFormat; Line:=-1; end; procedure TVczhBitmap.ToGray; var X,Y,R:Integer; B:Byte; begin for Y:=0 to Height-1 do for X:=0 to Width-1 do begin R:=0; for B:=0 to 2 do R:=R+GetBytes(X*3+B,Y); for B:=0 to 2 do SetBytes(X*3+B,Y,R div 3); end; end; end.

此后，我们需要建立几个窗体。第一个用来显示图片，第二个用来处理图片，其他的窗体都继承自第二个窗体，包含实际的处理方法。

先看第二个窗口：

?

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68

unit untProc; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, untBitmapProc, StdCtrls, ComCtrls; type TfrmProcessor = class(TForm) pbBar: TPaintBox; gpProc: TGroupBox; Button1: TButton; procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure FormShow(Sender: TObject); procedure pbBarPaint(Sender: TObject); procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } BarData:array[0..255]of Byte; Bar:TVczhBitmap; procedure DrawBar; end; var frmProcessor: TfrmProcessor; implementation {$R *.dfm} uses untViewer; procedure TfrmProcessor.DrawBar; var I:Integer; begin Bar.Canvas.FillRect(Bar.Canvas.ClipRect); Bar.Canvas.MoveTo(0,255-BarData[0]); for I:=1 to 255 do Bar.Canvas.LineTo(I,255-BarData[I]); end; procedure TfrmProcessor.FormCreate(Sender: TObject); begin Bar:=TVczhBitmap.Create; Bar.Width:=256; Bar.Height:=256; Bar.Canvas.Brush.Color:=clWhite; Bar.Canvas.Brush.Style:=bsSolid; end; procedure TfrmProcessor.FormDestroy(Sender: TObject); begin Bar.Free; end; procedure TfrmProcessor.FormShow(Sender: TObject); var I:Integer; begin for I:=0 to 255 do BarData[I]:=I; DrawBar; end; procedure TfrmProcessor.pbBarPaint(Sender: TObject); begin pbBar.Canvas.Draw(0,0,Bar); end; procedure TfrmProcessor.Button1Click(Sender: TObject); var X,Y:Integer; begin for Y:=0 to Buffer.Height-1 do for X:=0 to Buffer.Width*3-1 do Played.Bytes[X,Y]:=BarData[Buffer.Bytes[X,Y]]; frmViewer.FormPaint(frmViewer); end; end.

之后，做一个窗口继承自它，则调整BarData[]后，按Apply即可看到结果。

现在开始将图像处理。具体效果见示例程序。
　　
一、颜色反转。

灰度图像的颜色都是从0~255，所以，为了使颜色反转，我们可以用255减去该颜色值以得到反转后的颜色。

?

1 2 3 4 5 6 7 8

var I:Integer; begin inherited; for I:=0 to 255 do BarData[I]:=255-I;//用255减去该颜色值 DrawBar; pbBarPaint(pbBar); end;

二、缩小颜色范围以增强或减弱亮度

颜色本来是从0~255的。如果调节它的范围，例如从0~16，则会是图像明显变暗。我们可以把起始值设为a，把终止值设为b，则新的颜色值New=a+(b-1)*Old/255。这样做的话可以改变亮度，并且不会破坏原先颜色的顺序。代码如下

?

1 2 3 4 5 6 7 8

var I:Integer; begin for I:=0 to 255 do BarData[I]:=(255-sbMin.Position)+Round((sbMin.Position-sbMax.Position)/255*I); DrawBar; pbBarPaint(pbBar); Button1Click(Button1); end;

这里的sbMin.Position和sbMaxPosition都是反转过的。所以使用时要用255去减
　　
三、增加某个范围内的颜色范围

如果图像本身的颜色范围很小的画，你可以通过这种方法来加大图像的对比度，有利于对图像的分析。具体做法：

选取一个值a做为起始值，选取一个值b做为终止值，然后按以下公式变形：
　　|　0 (X<=a)
　　f(X)= |　255/(b-a)*(X-a)
　　|　255(X>=b)

?

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15

var I:Integer; begin for I:=0 to 255 do begin if I<=sbMin.Position then BarData[I]:=0 else if I>=sbMax.Position then BarData[I]:=255 else BarData[I]:=Round(255/(sbMax.Position-sbMin.Position)*(I-sbMin.Position)); end; DrawBar; pbBarPaint(pbBar); Button1Click(Button1); end;

四、变为黑白图片

在使用第三个功能的时候，你会发现当b<=a时，图像上的颜色除了黑色就是白色。这样操作的好处是不能直接显示出来的。这只要到了比较高级的图像处理如边缘检测等，才有作用。本例可以拿第三种方法的公式再变形，因此不作详细阐述。
　　
五、指数级亮度调整

我们假设这个图的定义域是[0,1]，值域也是[0,1]。那么，定义函数f(x)=x^c，则f(x)的图像有一段如上图。我们再用鼠标操作时，可以在上面取一点P(a,b)，然后使f(x)通过点P，则c=ln(b)/ln(a)。有了c之后，我们就可以对颜色进行操作了：

?

1 2 3 4 5 6 7 8 9 10 11 12 13

New=(Old/255)^c*255=exp(ln(old/255)*c)*255 var ea,eb,ec:Extended; I:Integer; begin ea:=A/255; eb:=B/255; ec:=Ln(eb)/Ln(ea); for I:=1 to 255 do BarData[I]:=Round(Exp(Ln((I/255))*ec)*255); DrawBar; pbBarPaint(pbBar); Button1Click(Button1); end;

这样做可以调节图像的亮度。

Delphi图形显示特效的技巧

概述

----目前在许多学习软件、游戏光盘中，经常会看到各种

图形显示技巧，凭着图形的移动、交错、雨滴状、百页窗、积木堆叠等显现方式，使画面变得更为生动活泼，更 能吸引观众。本文将探讨如何在delphi中实现各种图形显示技巧。

基本原理

----在delphi中，实现一副图象的显示是非常简单的，只要在form中定义一个timage组件，设置其picture属性，然后选 择任何有效的.ico、.bmp、.emf或.wmf文件，进行load，所选文 件就显示在timage组件中了。但这只是直接将图形显示在窗体中，毫无技巧可言。为了使图形显示具有别具一格的效果，可以按下列步骤实现：

----定义一个timage组件，把要显示的图形先装入到timage组件中，也就是说，把图形内容从磁盘载入内存中， 做为图形缓存。

----创建一新的位图对象，其尺寸跟timage组件中的图形一样。

----利用画布(canvas)的copyrect功能(将一个画布的矩形区域拷贝到另一个画布的矩形区域)，使用技巧，动态形

成位图文件内容，然后在窗体中显示位图。

----实现方法

下面介绍各种图形显示技巧：

1.推拉效果

将要显示的图形由上、下、左、右方向拉进屏幕内显示，同时将屏幕上原来的旧图盖掉，此种效果可分为四种，上拉、下拉、左拉、右拉，但原理都差不多，以上拉 效果为例。

原理：首先将放在暂存图形的第一条水平线，搬移至要显示的位图的最后一条，接着再将暂存图形的前两条水平线，依序搬移至要显示位图的最后两条水平线，然后搬移前三条、前四条叄?直到全部图形数据搬完为止。在搬移的过程中即可看到显示的位图由下而上浮起，而达到上拉的效果。

程序算法：

?

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20

procedure tform1.button1click(sender: tobject); var newbmp: tbitmap; i,bmpheight,bmpwidth:integer; begin newbmp:= tbitmap.create; newbmp.width:=image1.width; newbmp.height:=image1.height; bmpheight:=image1.height; bmpwidth:=image1.width; for i:=0 to bmpheight do begin newbmp.canvas.copyrect(rect (0,bmpheight-i,bmpwidth,bmpheight), image1.canvas, rect(0,0,bmpwidth,i)); form1.canvas.draw(120,100,newbmp); end; newbmp.free; end;

2.垂直交错效果

原理：将要显示的图形拆成两部分，奇数条扫描线由上往下搬移，偶数条扫描线的部分则由下往上搬移，而且两者同时进行。从屏幕上便可看到分别由上下两端出现的较淡图形向屏幕中央移动，直到完全清楚为止。

程序算法：

?

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30

procedure tform1.button4click(sender: tobject); var newbmp:tbitmap; i,j,bmpheight,bmpwidth:integer; begin newbmp:= tbitmap.create; newbmp.width:=image1.width; newbmp.height:=image1.height; bmpheight:=image1.height; bmpwidth:=image1.width; i:=0; while i< =bmpheight do begin j:=i; while j >0 do begin newbmp.canvas.copyrect(rect(0,j-1,bmpwidth,j), image1.canvas, rect(0,bmpheight-i+j-1,bmpwidth,bmpheight-i+j)); newbmp.canvas.copyrect(rect (0,bmpheight-j,bmpwidth,bmpheight-j+1), image1.canvas, rect(0,i-j,bmpwidth,i-j+1)); j:=j-2; end; form1.canvas.draw(120,100,newbmp); i:=i+2; end; newbmp.free; end;

3.水平交错效果

原理：同垂直交错效果原理一样，只是将分成两组后的图形分别由左右两端移进屏幕。

程序算法：

?

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30

procedure tform1.button5click(sender: tobject); var newbmp:tbitmap; i,j,bmpheight,bmpwidth:integer; begin newbmp:= tbitmap.create; newbmp.width:=image1.width; newbmp.height:=image1.height; bmpheight:=image1.height; bmpwidth:=image1.width; i:=0; while i< =bmpwidth do begin j:=i; while j >0 do begin newbmp.canvas.copyrect(rect(j-1,0,j,bmpheight), image1.canvas, rect(bmpwidth-i+j-1,0,bmpwidth-i+j,bmpheight)); newbmp.canvas.copyrect(rect (bmpwidth-j,0,bmpwidth-j+1,bmpheight), image1.canvas, rect(i-j,0,i-j+1,bmpheight)); j:=j-2; end; form1.canvas.draw(120,100,newbmp); i:=i+2; end; newbmp.free; end;

4.雨滴效果

原理：将暂存图形的最后一条扫描线，依序搬移到可视位图的第一条到最后一条扫描线，让此条扫描线在屏幕上留下它的轨迹。接着再把暂存图形的倒数第二条扫描线，依序搬移到可视位图的第一条到倒数第二条扫描线。其余的扫描线依此类推。

程序算法：

?

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20

procedure tform1.button3click(sender: tobject); var newbmp:tbitmap; i,j,bmpheight,bmpwidth:integer; begin newbmp:= tbitmap.create; newbmp.width:=image1.width; newbmp.height:=image1.height; bmpheight:=image1.height; bmpwidth:=image1.width; for i:=bmpheight downto 1 do for j:=1 to i do begin newbmp.canvas.copyrect(rect(0,j-1,bmpwidth,j), image1.canvas, rect(0,i-1,bmpwidth,i)); form1.canvas.draw(120,100,newbmp); end; newbmp.free; end;

5.百叶窗效果

原理：将放在暂存图形的数据分成若干组，然后依次从第一组到最后一组搬移，第一次每组各搬移第一条扫描线到可视位图的相应位置，第二次搬移第二条扫描线，接着搬移第三条、第四条扫描线.

程序算法：

?

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24

procedure tform1.button6click(sender: tobject); var newbmp:tbitmap; i,j,bmpheight,bmpwidth:integer; xgroup,xcount:integer; begin newbmp:= tbitmap.create; newbmp.width:=image1.width; newbmp.height:=image1.height; bmpheight:=image1.height; bmpwidth:=image1.width; xgroup:=16; xcount:=bmpheight div xgroup; for i:=0 to xcount do for j:=0 to xgroup do begin newbmp.canvas.copyrect(rect (0,xcount*j+i-1,bmpwidth,xcount*j+i), image1.canvas, rect(0,xcount*j+i-1,bmpwidth,xcount*j+i)); form1.canvas.draw(120,100,newbmp); end; newbmp.free; end;

6.积木效果

原理：是雨滴效果的一种变化，不同之处在于，积木效果每次搬移的是一块图形，而不只是一根扫描线。

程序算法：

?

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24

procedure tform1.button7click(sender: tobject); var newbmp:tbitmap; i,j,bmpheight,bmpwidth:integer; begin newbmp:= tbitmap.create; newbmp.width:=image1.width; newbmp.height:=image1.height; bmpheight:=image1.height; bmpwidth:=image1.width; i:=bmpheight; while i>0 do begin for j:=10 to i do begin newbmp.canvas.copyrect(rect(0,j-10,bmpwidth,j), image1.canvas, rect(0,i-10,bmpwidth,i)); form1.canvas.draw(120,100,newbmp); end; i:=i-10; end; newbmp.free; end;

结束语

上述图形显示效果均已上机通过。使用效果很好。
用Delphi实现图像放大镜

向窗体上添加两个TImage组件，其中一个TImage组件的Name属性设置为Image1，它充当原图片显示的载体。另一个TImage组件的Name属性设置为Image2，它可以显示放大后的图像。

本例的核心是StretchBlt函数，利用StretchBlt函数实现局部图像放大，响应代码如下：

?

1 2 3 4 5 6 7 8

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin 　StretchBlt(Image2.Canvas.Handle,0,0,Image2.Width,Image2.Height, 　Image1.Canvas.Handle, X-20,Y-20,40,40,SRCCOPY); 　Image2.Refresh; 　Screen.Cursors[1]:=LoadCursorFromFile('MAGNIFY.CUR'); 　Self.Cursor:=1; end;

程序首先会调用StretchBlt函数，以鼠标当前位置作为中心点，以边长为40选中Image1组件上的局部图像，并放大此局部图像到Image2组件上。然后通过调用Image2组件的Refresh方法以刷新Image2组件的显示。最后设置鼠标指针为新的形状。

程序代码如下：

?

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33

unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, StdCtrls; type 　TForm1 = class(TForm) 　Image1: TImage; 　Image2: TImage; 　procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer); 　procedure FormMouseMove(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 StretchBlt(Image2.Canvas.Handle,0,0,Image2.Width,Image2.Height,Image1.Canvas.Handle, X-20,Y-20,40,40,SRCCOPY); 　　Image2.Refresh; 　　Screen.Cursors[1]:=LoadCursorFromFile('MAGNIFY.CUR'); 　　Self.Cursor:=1; end; procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer); begin 　Screen.Cursors[1]:=crDefault; 　Self.Cursor:=1; end; end.

保存文件，然后按F9键运行程序，程序运行。
放大图像是一个优秀的看图软件必备的功能，本实例提供了一种非常简便易行的方法，不但代码数量少，而且执行效率高。

希望本文所述对大家的Delphi程序设计有所帮助。